@@ -51,5 +51,9 @@ $class->new(
'Scalar::Util' => 0,
'Email::Valid' => 0,
},
+ build_requires => {
+ # For testing
+ 'CGI' => 3.48,
+ },
)->create_build_script;
@@ -1,3 +1,27 @@
+4.65 Wed Dec 30 22:17:33 EST 2009
+
+ [NEW FEATURES]
+ - New FV_replace() filter to simplify basic find-and-replace filters:
+ field_filters => {
+ first_name => FV_replace(qr/Mark/,'Don'),
+ },
+
+ [BUG FIXES]
+ - Untainted multi-line fields are no longer truncated after the first newline.
+ (RT#44004, Thanks to Matthew Lawrence)
+ - Fix bug when the constraint_method contains a capturing parens and 0 is a valid value.
+ (RT#45177, Thanks to Junior Medina and Mark Stosberg)
+
+ [DOCUMENTATION]
+ - Typo fixes (Lyle)
+
+ [INTERNALS]
+ - Best Practice: Redundant <span> tag was removed from default error message formatting
+ (RT#42926), Thanks to girlwithglasses)
+ - Best Practice: eliminated some indirect object notation in the tests (Mark Stosberg)
+ - Now require a new CGI.pm for the build stage (RT#49912, thanks to dsteinbrunner)
+ - White space improvements (RT#30205, Thanks to Peter Liscovius)
+ - Fixed a warning in the test suite (RT#42251, Thanks to Frank Wiegand)
4.63 Sat Jan 3 12:46:15 EST 2009
[DOCUMENTATION]
@@ -1,10 +1,5 @@
Build.PL
Changes
-MANIFEST This list of files
-MANIFEST.SKIP
-META.yml
-README
-RELEASE_NOTES
lib/Data/FormValidator.pm
lib/Data/FormValidator/Constraints.pm
lib/Data/FormValidator/Constraints/Dates.pm
@@ -12,6 +7,11 @@ lib/Data/FormValidator/Constraints/Upload.pm
lib/Data/FormValidator/ConstraintsFactory.pm
lib/Data/FormValidator/Filters.pm
lib/Data/FormValidator/Results.pm
+MANIFEST This list of files
+MANIFEST.SKIP
+META.yml
+README
+RELEASE_NOTES
t/00_base.t
t/02_code_ref.t
t/03_dependency.t
@@ -33,13 +33,11 @@ t/26_qr.t
t/27_qualify_ref_happy_death.t
t/28_defaults_for_new.t
t/30_filter_definedness.t
-t/FV_length.t
-t/ValidatorPackagesTest1.pm
-t/ValidatorPackagesTest2.pm
t/any_errors.t
t/check_profile_syntax.t
t/constraint_method.t
t/constraint_method_string.t
+t/constraint_method_zero.t
t/constraint_regexp_map_profile_reuse.t
t/constraints_builtin.t
t/constraints_builtin_closure.t
@@ -55,6 +53,7 @@ t/dependency_groups.t
t/filter_constraints.t
t/filters_builtin.t
t/filters_shouldnt_modify.t
+t/FV_length.t
t/get_filtered_data.t
t/get_input_data.t
t/missing_optional.t
@@ -77,5 +76,7 @@ t/upload.t
t/upload_closure.t
t/upload_mime_types.t
t/upload_post_text.txt
+t/ValidatorPackagesTest1.pm
+t/ValidatorPackagesTest2.pm
test/00_base.badformat
test/00_base.profile
@@ -30,3 +30,4 @@ rejects
^Build$
+^MYMETA.yml$
@@ -1,47 +1,53 @@
---- #YAML:1.0
-name: Data-FormValidator
-version: 4.63
+---
+abstract: "Validates user input (usually from an HTML form) based\non input profile."
author:
- - Mark Stosberg <mark@summersault.com>
-abstract: |-
- Validates user input (usually from an HTML form) based
- on input profile.
+ - 'Mark Stosberg <mark@summersault.com>'
+build_requires:
+ CGI: 3.48
+configure_requires:
+ Module::Build: 0.36
+generated_by: 'Module::Build version 0.3601'
license: perl
-requires:
- Date::Calc: 5
- Email::Valid: 0
- File::MMagic: 1.17
- Image::Size: 0
- MIME::Types: 1.005
- Perl6::Junction: 1.1
- Regexp::Common: 0
- Scalar::Util: 0
- Test::More: 0
- overload: 0
- perl: 5.008
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Data-FormValidator
provides:
Data::FormValidator:
file: lib/Data/FormValidator.pm
- version: 4.63
+ version: 4.65
Data::FormValidator::Constraints:
file: lib/Data/FormValidator/Constraints.pm
- version: 4.63
+ version: 4.65
Data::FormValidator::Constraints::Dates:
file: lib/Data/FormValidator/Constraints/Dates.pm
- version: 4.62
+ version: 4.65
Data::FormValidator::Constraints::RegexpCommon:
file: lib/Data/FormValidator/Results.pm
- version: 4.62
Data::FormValidator::Constraints::Upload:
file: lib/Data/FormValidator/Constraints/Upload.pm
- version: 4.62
+ version: 4.65
Data::FormValidator::ConstraintsFactory:
file: lib/Data/FormValidator/ConstraintsFactory.pm
version: 1.7
Data::FormValidator::Filters:
file: lib/Data/FormValidator/Filters.pm
- version: 4.62
+ version: 4.65
Data::FormValidator::Results:
file: lib/Data/FormValidator/Results.pm
- version: 4.62
-generated_by: Module::Build version 0.2611
+ version: 4.65
+requires:
+ Date::Calc: 5
+ Email::Valid: 0
+ File::MMagic: 1.17
+ Image::Size: 0
+ MIME::Types: 1.005
+ Perl6::Junction: 1.1
+ Regexp::Common: 0
+ Scalar::Util: 0
+ Test::More: 0
+ overload: 0
+ perl: 5.008
+resources:
+ license: http://dev.perl.org/licenses/
+version: 4.65
@@ -4,9 +4,9 @@ NAME
SYNOPSIS
use Data::FormValidator;
-
+
my $results = Data::FormValidator->check(\%input_hash, \%dfv_profile);
-
+
if ($results->has_invalid or $results->has_missing) {
# do something with $results->invalid, $results->missing
# or $results->msgs
@@ -51,7 +51,7 @@ VALIDATING INPUT
The second argument is a reference to the profile you are validating.
validate()
- my( $valids, $missings, $invalids, $unknowns ) =
+ my( $valids, $missings, $invalids, $unknowns ) =
Data::FormValidator->validate( \%input_hash, \%dfv_profile);
"validate()" provides a deprecated alternative to "check()". It has the
@@ -145,11 +145,11 @@ VALIDATING INPUT
# and provide some defaults to new constructor
sub check_form {
my $self = shift;
- my $profile = shift
+ my $profile = shift
|| die 'check_form: missing required profile';
-
+
require Data::FormValidator;
- my $dfv = Data::FormValidator->new({},{
+ my $dfv = Data::FormValidator->new({},{
# your defaults here
});
return $dfv->check($self->query,$profile);
@@ -166,16 +166,16 @@ INPUT PROFILE SPECIFICATION
my $profile = {
optional => [qw( company
- fax
+ fax
country )],
- required => [qw( fullname
- phone
- email
+ required => [qw( fullname
+ phone
+ email
address )],
constraint_methods => {
- email => email(),
+ email => email(),
}
};
@@ -199,7 +199,7 @@ INPUT PROFILE SPECIFICATION
require_some
require_some => {
# require any two fields from this group
- city_or_state_or_zipcode => [ 2, qw/city state zipcode/ ],
+ city_or_state_or_zipcode => [ 2, qw/city state zipcode/ ],
}
This is a reference to a hash which defines groups of fields where 1 or
@@ -241,7 +241,7 @@ INPUT PROFILE SPECIFICATION
"cc_type" => sub {
my $dfv = shift;
my $type = shift;
-
+
return [ 'cc_cvv' ] if ($type eq "VISA" || $type eq "MASTERCARD");
return [ ];
},
@@ -301,7 +301,7 @@ INPUT PROFILE SPECIFICATION
Note that it doesn't make sense to use a default for a field handled by
"optional_regexp" or "required_regexp". When the field is not submitted,
- there is no way know that it should be optional or required, and thus
+ there is no way to know that it should be optional or required, and thus
there's no way to know that a default should be set for it.
filters
@@ -321,7 +321,7 @@ INPUT PROFILE SPECIFICATION
See Data::FormValidator::Filters for details on the built-in filters.
field_filters
- field_filters => {
+ field_filters => {
cc_no => ['digit'],
},
@@ -393,26 +393,26 @@ INPUT PROFILE SPECIFICATION
This will check the input and return true or false depending on the
input's validity. By default, the constraint function receives a
Data::FormValidator::Results object as its first argument, and the
- value to be validated as the second. To validate a field based more
- inputs than just the field itself, see "VALIDATING INPUT BASED ON
- MULTIPLE FIELDS".
+ value to be validated as the second. To validate a field based on
+ more inputs than just the field itself, see "VALIDATING INPUT BASED
+ ON MULTIPLE FIELDS".
Examples:
- # Notice the use of 'pop'--
+ # Notice the use of 'pop'--
# the object is the first arg passed to the method
# while the value is the second, and last arg.
- my_zipcode_field => sub { my $val = pop; return $val =~ '/^\d{5}$/' },
-
+ my_zipcode_field => sub { my $val = pop; return $val =~ '/^\d{5}$/' },
+
# OR you can reference a subroutine, which should work like the one above
- my_zipcode_field => \&my_validation_routine,
+ my_zipcode_field => \&my_validation_routine,
# An example of setting the constraint name.
- my_zipcode_field => sub {
- my ($dfv, $val) = @_;
- $dfv->set_current_constraint_name('my_constraint_name');
- return $val =~ '/^\d{5}$/'
- },
+ my_zipcode_field => sub {
+ my ($dfv, $val) = @_;
+ $dfv->set_current_constraint_name('my_constraint_name');
+ return $val =~ '/^\d{5}$/'
+ },
o an array reference
@@ -425,11 +425,11 @@ INPUT PROFILE SPECIFICATION
constraint_method_regexp_map
use Data::FormValidator::Constraints qw(:closures);
- # In your profile.
+ # In your profile.
constraint_method_regexp_map => {
# All fields that end in _postcode have the 'postcode' constraint applied.
qr/_postcode$/ => postcode(),
- },
+ },
A hash ref where the keys are the regular expressions to use and the
values are the constraints to apply.
@@ -447,8 +447,7 @@ INPUT PROFILE SPECIFICATION
Untainting is based on the pattern match used by the constraint. Note
that some constraint routines may not provide untainting.
- See Writing your own constraint routines in the
- Data::FormValidator::Constraints documentation for more information.
+ See Writing your own constraint routines for more information.
This is overridden by "untaint_constraint_fields" and
"untaint_regexp_map".
@@ -499,8 +498,8 @@ INPUT PROFILE SPECIFICATION
just their name, just like built-in routines. You can even override the
provided validators.
- See "WRITING YOUR OWN CONSTRAINT ROUTINES" in the
- Data::FormValidator::Constraints documentation for more information
+ See Writing your own constraint routines documentation for more
+ information
msgs
This key is used to define parameters related to formatting error
@@ -516,7 +515,7 @@ INPUT PROFILE SPECIFICATION
The default formatting applied is designed for display in an XHTML web
page. That formatting is as followings:
- <span style="color:red;font-weight:bold"><span class="dfv_errors">* %s</span></span>
+ <span style="color:red;font-weight:bold" class="dfv_errors">* %s</span>
The %s will be replaced with the message. The effect is that the message
will appear in bold red with an asterisk before it. This style can be
@@ -528,31 +527,31 @@ INPUT PROFILE SPECIFICATION
handling multiple constraints:
msgs => {
-
+
# set a custom error prefix, defaults to none
prefix=> 'error_',
-
+
# Set your own "Missing" message, defaults to "Missing"
missing => 'Not Here!',
-
+
# Default invalid message, default's to "Invalid"
invalid => 'Problematic!',
-
+
# message separator for multiple messages
# Defaults to ' '
invalid_separator => ' <br /> ',
-
+
# formatting string, default given above.
format => 'ERROR: %s',
-
+
# Error messages, keyed by constraint name
# Your constraints must be named to use this.
constraints => {
'date_and_time' => 'Not a valid time format',
# ...
},
-
- # This token will be included in the hash if there are
+
+ # This token will be included in the hash if there are
# any errors returned. This can be useful with templating
# systems like HTML::Template
# The 'prefix' setting does not apply here.
@@ -574,8 +573,8 @@ INPUT PROFILE SPECIFICATION
This will be called as a Data::FormValidator::Results method. It may
receive as arguments an additional hash reference of control parameters,
- corresponding to the key names in the usually used in the "msgs" area of
- the profile. You can ignore this information if you'd like.
+ corresponding to the key names usually used in the "msgs" area of the
+ profile. You can ignore this information if you'd like.
If you have an alternative error message handler you'd like to share,
stick in the "Data::FormValidator::ErrMsgs" name space and upload it to
@@ -631,7 +630,7 @@ VALIDATING INPUT BASED ON MULTIPLE FIELDS
Example:
- cc_no => {
+ cc_no => {
constraint => "cc_number",
params => [ qw( cc_no cc_type ) ],
},
@@ -649,8 +648,8 @@ MULTIPLE CONSTRAINTS
my_zipcode_field => [
'zip',
- {
- constraint => '/^406/',
+ {
+ constraint => '/^406/',
name => 'starts_with_406',
}
],
@@ -672,7 +671,7 @@ ADVANCED VALIDATION
BACKWARDS COMPATIBILITY
validate()
- my( $valids, $missings, $invalids, $unknowns ) =
+ my( $valids, $missings, $invalids, $unknowns ) =
Data::FormValidator->validate( \%input_hash, \%dfv_profile);
"validate()" provides a deprecated alternative to "check()". It has the
@@ -710,7 +709,7 @@ BACKWARDS COMPATIBILITY
more versatile interface.
constraints => {
- cc_no => {
+ cc_no => {
constraint => "cc_number",
params => [ qw( cc_no cc_type ) ],
},
@@ -741,7 +740,7 @@ BACKWARDS COMPATIBILITY
"constraint_methods" and "$self-\"name_this('foo')>.
# supply multiple parameters
- cc_no => {
+ cc_no => {
constraint => "cc_number",
params => [ qw( cc_no cc_type ) ],
},
@@ -781,7 +780,7 @@ BACKWARDS COMPATIBILITY
constraint_regexp_map => {
# All fields that end in _postcode have the 'postcode' constraint applied.
qr/_postcode$/ => 'postcode',
- },
+ },
A hash ref where the keys are the regular expressions to use and the
values are the constraints to apply.
@@ -12,66 +12,66 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
-# This allows declaration use Foo ':all';
+# This allows declaration use Foo ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(
-
+
) ] );
-@EXPORT_OK = (
- 'date_and_time',
- @{ $EXPORT_TAGS{'all'} }
+@EXPORT_OK = (
+ 'date_and_time',
+ @{ $EXPORT_TAGS{'all'} }
);
@EXPORT = qw(
- match_date_and_time
+ match_date_and_time
);
-$VERSION = '4.62';
+$VERSION = '4.65';
sub date_and_time {
- my $fmt = shift;
- return sub {
- my $self = shift;
- $self->set_current_constraint_name('date_and_time');
- return match_date_and_time($self,\$fmt);
- }
+ my $fmt = shift;
+ return sub {
+ my $self = shift;
+ $self->set_current_constraint_name('date_and_time');
+ return match_date_and_time($self,\$fmt);
+ }
}
sub match_date_and_time {
- my $self = shift;
- my $fmt_ref = shift || die q!date_and_time: need format parameter. Be sure to pass it by reference, like this: \'MM/DD/YYYY'!;
- my $fmt = $$fmt_ref;
+ my $self = shift;
+ my $fmt_ref = shift || die q!date_and_time: need format parameter. Be sure to pass it by reference, like this: \'MM/DD/YYYY'!;
+ my $fmt = $$fmt_ref;
require Date::Calc;
import Date::Calc (qw/check_date check_time/);
- my $format = _prepare_date_format($fmt);
- my ($date,$Y,$M,$D,$h,$m,$s) = _parse_date_format($format,$self->get_current_constraint_value);
- return if not defined $date;
+ my $format = _prepare_date_format($fmt);
+ my ($date,$Y,$M,$D,$h,$m,$s) = _parse_date_format($format,$self->get_current_constraint_value);
+ return if not defined $date;
+
-
- # We need to check the date if we find any in the format string, otherwise, it succeeds
- my $date_test = 1;
- $date_test = check_date($Y,$M,$D) if ($fmt =~ /[YMD]/) ;
+ # We need to check the date if we find any in the format string, otherwise, it succeeds
+ my $date_test = 1;
+ $date_test = check_date($Y,$M,$D) if ($fmt =~ /[YMD]/) ;
- # If we find a time, check that
- my $time_test = 1;
- $time_test = check_time($h,$m,$s) if ($fmt =~ /[hms]/) ;
+ # If we find a time, check that
+ my $time_test = 1;
+ $time_test = check_time($h,$m,$s) if ($fmt =~ /[hms]/) ;
- # If either the time or date fails, it all fails
- return ($date_test && $time_test) ? $date : undef;
+ # If either the time or date fails, it all fails
+ return ($date_test && $time_test) ? $date : undef;
}
sub _prepare_date_format {
my $format = shift;
- # Originally by Jan Krynicky
+ # Originally by Jan Krynicky
# TODO: check that only valid characters appear in the format
# The logic should be: for any character A-Z in the format string,
- # die if it's not one of: Y M D h m s p
+ # die if it's not one of: Y M D h m s p
my ($i, @order) = 0;
$format =~ s{(Y+|M+|D+|h+|m+|s+|pp)(\?)?}{
@@ -93,7 +93,7 @@ sub _prepare_date_format {
}
sub _parse_date_format {
- # Originally by Jan Krynicky
+ # Originally by Jan Krynicky
my ($format, $date) = @_;
my ($untainted_date,@data) = ($date =~ $format->[0])
@@ -121,36 +121,36 @@ Data::FormValidator::Constraints::Dates - Validate Dates and Times
=head1 SYNOPSIS
- use Data::FormValidator::Constraints::Dates qw(date_and_time);
+ use Data::FormValidator::Constraints::Dates qw(date_and_time);
- # In a DFV profile...
- constraint_methods => {
- # 'pp' denotes AM|PM for 12 hour representation
- my_time_field => date_and_time('MM/DD/YYYY hh:mm:ss pp'),
- }
+ # In a DFV profile...
+ constraint_methods => {
+ # 'pp' denotes AM|PM for 12 hour representation
+ my_time_field => date_and_time('MM/DD/YYYY hh:mm:ss pp'),
+ }
=head1 DESCRIPTION
=head2 date_and_time
-B<Note:> This is a new module is a new addition to Data::FormValidator and is
-should be considered "Beta".
+B<Note:> This is a new module is a new addition to Data::FormValidator and is
+should be considered "Beta".
This constraint creates a regular expression based on the format string
passed in to validate your date against. It understands the following symbols:
- Y year (numeric)
- M month (numeric)
- D day (numeric)
- h hour
- m minute
- s second
- p AM|PM
+ Y year (numeric)
+ M month (numeric)
+ D day (numeric)
+ h hour
+ m minute
+ s second
+ p AM|PM
Other parts of the string become part of the regular expression, so you can
do perlish things like this to create more complex expressions:
- 'MM?/DD?/YYYY|YYYY-MM?-DD?'
+ 'MM?/DD?/YYYY|YYYY-MM?-DD?'
Internally L<Date::Calc> is used to test the functions.
@@ -158,43 +158,43 @@ Internally L<Date::Calc> is used to test the functions.
This older, more awkward interface is supported:
- # In a Data::FormValidator Profile:
- validator_packages => [qw(Data::FormValidator::Constraints::Dates)],
- constraints => {
- date_and_time_field => {
- constraint_method => 'date_and_time',
- params=>[\'MM/DD/YYYY hh:mm:ss pp'], # 'pp' denotes AM|PM for 12 hour representation
- },
- }
+ # In a Data::FormValidator Profile:
+ validator_packages => [qw(Data::FormValidator::Constraints::Dates)],
+ constraints => {
+ date_and_time_field => {
+ constraint_method => 'date_and_time',
+ params=>[\'MM/DD/YYYY hh:mm:ss pp'], # 'pp' denotes AM|PM for 12 hour representation
+ },
+ }
=head1 SEE ALSO
-=over
+=over
=item o
L<Data::FormValidator>
-=item o
+=item o
L<Data::FormValidator::Constraints::DateTime> - This alternative features
returning dates as DateTime objects and validating against the date formats
-required for the MySQL and PostgreSQL databases.
+required for the MySQL and PostgreSQL databases.
-=back
+=back
=head1 AUTHOR
Mark Stosberg, E<lt>mark@summersault.comE<gt>
-Featuring clever code by Jan Krynicky.
+Featuring clever code by Jan Krynicky.
=head1 COPYRIGHT AND LICENSE
Copyright 2003-2005 by Mark Stosberg
This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+it under the same terms as Perl itself.
=cut
@@ -10,92 +10,92 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
-# This allows declaration use Data::FormValidator::Constraints::Upload ':all';
+# This allows declaration use Data::FormValidator::Constraints::Upload ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
@EXPORT = qw(
- valid_file_format
- valid_image_max_dimensions
- valid_file_max_bytes
- valid_image_min_dimensions
+ valid_file_format
+ valid_image_max_dimensions
+ valid_file_max_bytes
+ valid_image_min_dimensions
);
@EXPORT_OK = qw(
- file_format
- image_max_dimensions
- file_max_bytes
- image_min_dimensions
+ file_format
+ image_max_dimensions
+ file_max_bytes
+ image_min_dimensions
);
-$VERSION = 4.62;
+$VERSION = 4.65;
sub file_format {
- my %params = @_;
- return sub {
- my $self = shift;
- $self->set_current_constraint_name('file_format');
- valid_file_format($self,\%params);
- }
+ my %params = @_;
+ return sub {
+ my $self = shift;
+ $self->set_current_constraint_name('file_format');
+ valid_file_format($self,\%params);
+ }
}
sub image_max_dimensions {
- my $w = shift || die 'image_max_dimensions: missing maximum width value';
- my $h = shift || die 'image_max_dimensions: missing maximum height value';
- return sub {
- my $self = shift;
- $self->set_current_constraint_name('image_max_dimensions');
- valid_image_max_dimensions($self,\$w,\$h);
- }
+ my $w = shift || die 'image_max_dimensions: missing maximum width value';
+ my $h = shift || die 'image_max_dimensions: missing maximum height value';
+ return sub {
+ my $self = shift;
+ $self->set_current_constraint_name('image_max_dimensions');
+ valid_image_max_dimensions($self,\$w,\$h);
+ }
}
sub file_max_bytes {
- my ($max_bytes) = @_;
- return sub {
- my $self = shift;
- $self->set_current_constraint_name('file_max_bytes');
- valid_file_max_bytes($self,\$max_bytes);
- }
+ my ($max_bytes) = @_;
+ return sub {
+ my $self = shift;
+ $self->set_current_constraint_name('file_max_bytes');
+ valid_file_max_bytes($self,\$max_bytes);
+ }
}
sub image_min_dimensions {
- my $w = shift || die 'image_min_dimensions: missing minimum width value';
- my $h = shift || die 'image_min_dimensions: missing minimum height value';
- return sub {
- my $self = shift;
- $self->set_current_constraint_name('image_min_dimensions');
- valid_image_min_dimensions($self,\$w,\$h);
- }
+ my $w = shift || die 'image_min_dimensions: missing minimum width value';
+ my $h = shift || die 'image_min_dimensions: missing minimum height value';
+ return sub {
+ my $self = shift;
+ $self->set_current_constraint_name('image_min_dimensions');
+ valid_image_min_dimensions($self,\$w,\$h);
+ }
}
sub valid_file_format {
- my $self = shift;
- $self->isa('Data::FormValidator::Results') ||
- die "file_format: first argument is not a Data::FormValidator::Results object. ";
- my $params = shift || {};
- # if (ref $params ne 'HASH' ) {
- # die "format: hash reference expected. Make sure you have
- # included 'params => []' in your constraint definition, even if there
- # are no additional arguments";
- # }
- my $q = $self->get_filtered_data;
-
- my $field = $self->get_current_constraint_field;
- my $fh = _get_upload_fh($self);
-
- ## load filehandle
- if (!$fh) {
- warn "$0: can't get filehandle for field named $field" and return undef;
- }
-
- ## load file magic stuff
- require File::MMagic;
- my $mm = File::MMagic->new;
- my $fm_mt;
-
- ## only use filehandle bits for magic data
- $fm_mt = $mm->checktype_filehandle($fh) ||
- (warn "$0: can't get filehandle for field named $field" and return undef);
+ my $self = shift;
+ $self->isa('Data::FormValidator::Results') ||
+ die "file_format: first argument is not a Data::FormValidator::Results object. ";
+ my $params = shift || {};
+ # if (ref $params ne 'HASH' ) {
+ # die "format: hash reference expected. Make sure you have
+ # included 'params => []' in your constraint definition, even if there
+ # are no additional arguments";
+ # }
+ my $q = $self->get_filtered_data;
+
+ my $field = $self->get_current_constraint_field;
+ my $fh = _get_upload_fh($self);
+
+ ## load filehandle
+ if (!$fh) {
+ warn "$0: can't get filehandle for field named $field" and return undef;
+ }
+
+ ## load file magic stuff
+ require File::MMagic;
+ my $mm = File::MMagic->new;
+ my $fm_mt;
+
+ ## only use filehandle bits for magic data
+ $fm_mt = $mm->checktype_filehandle($fh) ||
+ (warn "$0: can't get filehandle for field named $field" and return undef);
# Work around a bug in File::MMagic (RT#12074)
seek($fh,0,0);
@@ -108,8 +108,8 @@ sub valid_file_format {
$fm_mt = undef if ($fm_mt eq 'application/octet-stream');
- ## fetch mime type universally (or close)
- my $uploaded_mt = _get_upload_mime_type($self);
+ ## fetch mime type universally (or close)
+ my $uploaded_mt = _get_upload_mime_type($self);
# try the File::MMagic, then the uploaded field, then return undef we find neither
my $mt = ($fm_mt || $uploaded_mt) or return undef;
@@ -120,25 +120,25 @@ sub valid_file_format {
my MIME::Type $t = $mimetypes->type($mt);
my @mt_exts = $t ? $t->extensions : ();
- ## setup filename to retrieve extension
- my $fn = $self->get_input_data->param($field);
- my ($uploaded_ext) = ($fn =~ m/\.([\w\d]*)?$/);
+ ## setup filename to retrieve extension
+ my $fn = $self->get_input_data->param($field);
+ my ($uploaded_ext) = ($fn =~ m/\.([\w\d]*)?$/);
my $ext;
-
+
if (scalar @mt_exts) {
- # If the upload extension is one recognized by MIME::Type, use it.
- if (grep {/^$uploaded_ext$/} @mt_exts) {
- $ext = $uploaded_ext;
- }
- # otherwise, use one from MIME::Type, just to be safe
- else {
- $ext = $mt_exts[0];
- }
+ # If the upload extension is one recognized by MIME::Type, use it.
+ if (grep {/^$uploaded_ext$/} @mt_exts) {
+ $ext = $uploaded_ext;
+ }
+ # otherwise, use one from MIME::Type, just to be safe
+ else {
+ $ext = $mt_exts[0];
+ }
}
else {
- # If is a provided extension but no MIME::Type extension, use that.
- # It's possible that there no extension uploaded or found)
- $ext = $uploaded_ext;
+ # If is a provided extension but no MIME::Type extension, use that.
+ # It's possible that there no extension uploaded or found)
+ $ext = $uploaded_ext;
}
# Add the mime_type and extension to the valid data set
@@ -160,28 +160,28 @@ sub _is_allowed_type {
my %allowed_types = map { $_ => 1 } @{ $params->{mime_types} };
return $allowed_types{lc $mt};
-}
+}
sub valid_image_max_dimensions {
- my $self = shift;
- $self->isa('Data::FormValidator::Results') ||
- die "image_max_dimensions: first argument is not a Data::FormValidator::Results object. ";
- my $max_width_ref = shift || die 'image_max_dimensions: missing maximum width value';
- my $max_height_ref = shift || die 'image_max_dimensions: missing maximum height value';
- my $max_width = $$max_width_ref;
- my $max_height = $$max_height_ref;
- ($max_width > 0) || die 'image_max_dimensions: maximum width must be > 0';
- ($max_height > 0) || die 'image_max_dimensions: maximum height must be > 0';
-
- my $q = $self->get_filtered_data;
- my $field = $self->get_current_constraint_field;
- my ($width,$height) = _get_img_size($self);
-
- unless ($width) {
- warn "$0: imgsize test failed";
- return undef;
- }
+ my $self = shift;
+ $self->isa('Data::FormValidator::Results') ||
+ die "image_max_dimensions: first argument is not a Data::FormValidator::Results object. ";
+ my $max_width_ref = shift || die 'image_max_dimensions: missing maximum width value';
+ my $max_height_ref = shift || die 'image_max_dimensions: missing maximum height value';
+ my $max_width = $$max_width_ref;
+ my $max_height = $$max_height_ref;
+ ($max_width > 0) || die 'image_max_dimensions: maximum width must be > 0';
+ ($max_height > 0) || die 'image_max_dimensions: maximum height must be > 0';
+
+ my $q = $self->get_filtered_data;
+ my $field = $self->get_current_constraint_field;
+ my ($width,$height) = _get_img_size($self);
+
+ unless ($width) {
+ warn "$0: imgsize test failed";
+ return undef;
+ }
# Add the dimensions to the valid hash
my $info = $self->meta($field) || {};
@@ -192,31 +192,31 @@ sub valid_image_max_dimensions {
}
sub valid_file_max_bytes {
- my $self = shift;
+ my $self = shift;
- $self->isa('Data::FormValidator::Results') ||
- die "first argument is not a Data::FormValidator::Results object.";
-
- my $max_bytes_ref = shift;
- my $max_bytes;
+ $self->isa('Data::FormValidator::Results') ||
+ die "first argument is not a Data::FormValidator::Results object.";
- if ((ref $max_bytes_ref) and defined $$max_bytes_ref) {
- $max_bytes = $$max_bytes_ref;
- }
- else {
- $max_bytes = 1024*1024; # default to 1 Meg
- }
+ my $max_bytes_ref = shift;
+ my $max_bytes;
- my $q = $self->get_filtered_data;
+ if ((ref $max_bytes_ref) and defined $$max_bytes_ref) {
+ $max_bytes = $$max_bytes_ref;
+ }
+ else {
+ $max_bytes = 1024*1024; # default to 1 Meg
+ }
+
+ my $q = $self->get_filtered_data;
- my $field = $self->get_current_constraint_field;
+ my $field = $self->get_current_constraint_field;
- ## retrieve upload fh for field
- my $fh = _get_upload_fh($self);
- if (!$fh) { warn "Failed to load filehandle for $field" && return undef; }
+ ## retrieve upload fh for field
+ my $fh = _get_upload_fh($self);
+ if (!$fh) { warn "Failed to load filehandle for $field" && return undef; }
- ## retrieve size
- my $file_size = (stat ($fh))[7];
+ ## retrieve size
+ my $file_size = (stat ($fh))[7];
# Add the size to the valid hash
my $info = $self->meta($field) || {};
@@ -227,89 +227,89 @@ sub valid_file_max_bytes {
}
sub valid_image_min_dimensions {
- my $self = shift;
- $self->isa('Data::FormValidator::Results') ||
- die "image_min_dimensions: first argument is not a Data::FormValidator::Results object. ";
- my $min_width_ref = shift ||
- die 'image_min_dimensions: missing minimum width value';
- my $min_height_ref = shift ||
- die 'image_min_dimensions: missing minimum height value';
- my $min_width = $$min_width_ref;
- my $min_height = $$min_height_ref;
-
- ## do these matter?
- ($min_width > 0) || die 'image_min_dimensions: minimum width must be > 0';
- ($min_height > 0) || die 'image_min_dimensions: minimum height must be > 0';
-
- my $q = $self->get_filtered_data;
- my $field = $self->get_current_constraint_field;
- my ($width, $height) = _get_img_size($self);
-
- unless ($width) {
- warn "image failed processing";
- return undef;
- }
-
- # Add the dimensions to the valid hash
- my $info = $self->meta($field) || {};
- $info = { %$info, width => $width, height => $height };
- $self->meta($field,$info);
-
- return (($width >= $min_width) and ($height >= $min_height));
+ my $self = shift;
+ $self->isa('Data::FormValidator::Results') ||
+ die "image_min_dimensions: first argument is not a Data::FormValidator::Results object. ";
+ my $min_width_ref = shift ||
+ die 'image_min_dimensions: missing minimum width value';
+ my $min_height_ref = shift ||
+ die 'image_min_dimensions: missing minimum height value';
+ my $min_width = $$min_width_ref;
+ my $min_height = $$min_height_ref;
+
+ ## do these matter?
+ ($min_width > 0) || die 'image_min_dimensions: minimum width must be > 0';
+ ($min_height > 0) || die 'image_min_dimensions: minimum height must be > 0';
+
+ my $q = $self->get_filtered_data;
+ my $field = $self->get_current_constraint_field;
+ my ($width, $height) = _get_img_size($self);
+
+ unless ($width) {
+ warn "image failed processing";
+ return undef;
+ }
+
+ # Add the dimensions to the valid hash
+ my $info = $self->meta($field) || {};
+ $info = { %$info, width => $width, height => $height };
+ $self->meta($field,$info);
+
+ return (($width >= $min_width) and ($height >= $min_height));
}
sub _get_img_size
{
- my $self = shift;
- my $q = $self->get_filtered_data;
+ my $self = shift;
+ my $q = $self->get_filtered_data;
- ## setup caller to make can errors more useful
- my $caller = (caller(1))[3];
- my $pkg = __PACKAGE__ . "::";
- $caller =~ s/$pkg//g;
+ ## setup caller to make can errors more useful
+ my $caller = (caller(1))[3];
+ my $pkg = __PACKAGE__ . "::";
+ $caller =~ s/$pkg//g;
- my $field = $self->get_current_constraint_field;
+ my $field = $self->get_current_constraint_field;
- ## retrieve filehandle from query object.
- my $fh = _get_upload_fh($self);
+ ## retrieve filehandle from query object.
+ my $fh = _get_upload_fh($self);
- ## check error
- if (not $fh) {
+ ## check error
+ if (not $fh) {
warn "Unable to load filehandle";
- return undef;
+ return undef;
}
- require Image::Size;
- import Image::Size;
+ require Image::Size;
+ import Image::Size;
- ## check size
- my ($width, $height, $err) = imgsize($fh);
+ ## check size
+ my ($width, $height, $err) = imgsize($fh);
- unless ($width) {
- warn "$caller: imgsize test failed: $err";
- return undef;
- }
+ unless ($width) {
+ warn "$caller: imgsize test failed: $err";
+ return undef;
+ }
- return ($width, $height);
+ return ($width, $height);
}
## fetch filehandle for use with various file type checking
-## call it with (_get_upload_fh($self)) since kind of mock object
+## call it with (_get_upload_fh($self)) since kind of mock object
sub _get_upload_fh
{
- my $self = shift;
- my $q = $self->get_filtered_data;
- my $field = $self->get_current_constraint_field;
+ my $self = shift;
+ my $q = $self->get_filtered_data;
+ my $field = $self->get_current_constraint_field;
- # convert the FH for the filtered data into a -seekable- handle;
- # depending on whether we're using CGI::Simple, CGI, or Apache::Request
- # we might not have something -seekable-.
- use IO::File;
+ # convert the FH for the filtered data into a -seekable- handle;
+ # depending on whether we're using CGI::Simple, CGI, or Apache::Request
+ # we might not have something -seekable-.
+ use IO::File;
# If we we already have an IO::File object, return it, otherwise create one.
require Scalar::Util;
- if ( Scalar::Util::blessed($q->{$field}) && $q->{$field}->isa('IO::File') ) {
+ if ( Scalar::Util::blessed($q->{$field}) && $q->{$field}->isa('IO::File') ) {
return $q->{$field};
}
else {
@@ -323,32 +323,32 @@ sub _get_upload_fh
## NOTE: retrieves from original uploaded, -UNFILTERED- data
sub _get_upload_mime_type
{
- my $self = shift;
- my $q = $self->get_input_data;
- my $field = $self->get_current_constraint_field;
-
- if ($q->isa('CGI')) {
- my $fn = $q->param($field);
-
- ## nicely check for info
- if ($q->uploadInfo($fn)) {
- return $q->uploadInfo($fn)->{'Content-Type'}
- }
-
- return undef;
- }
-
- if ($q->isa('CGI::Simple')) {
- my $fn = $q->param($field);
- return $q->upload_info($fn, 'mime');
- }
-
- if ($q->isa('Apache::Request')) {
- my $upload = $q->upload($field);
- return $upload->info('Content-type');
- }
-
- return undef;
+ my $self = shift;
+ my $q = $self->get_input_data;
+ my $field = $self->get_current_constraint_field;
+
+ if ($q->isa('CGI')) {
+ my $fn = $q->param($field);
+
+ ## nicely check for info
+ if ($q->uploadInfo($fn)) {
+ return $q->uploadInfo($fn)->{'Content-Type'}
+ }
+
+ return undef;
+ }
+
+ if ($q->isa('CGI::Simple')) {
+ my $fn = $q->param($field);
+ return $q->upload_info($fn, 'mime');
+ }
+
+ if ($q->isa('Apache::Request')) {
+ my $upload = $q->upload($field);
+ return $upload->info('Content-type');
+ }
+
+ return undef;
}
@@ -363,31 +363,31 @@ Data::FormValidator::Constraints::Upload - Validate File Uploads
# Be sure to use a CGI.pm or CGI::Simple object as the form
# input when using this constraint
- my $q = new CGI;
-
- use Data::FormValidator::Constraints::Upload qw(
- file_format
- file_max_bytes
- image_max_dimensions
- image_min_dimensions
- );
+ my $q = CGI->new;
+
+ use Data::FormValidator::Constraints::Upload qw(
+ file_format
+ file_max_bytes
+ image_max_dimensions
+ image_min_dimensions
+ );
my $dfv = Data::FormValidator->check($q,$my_profile);
- # In a Data::FormValidator Profile:
- constraint_methods => {
- image_name => [
- file_format(),
- file_max_bytes(10),
- image_max_dimensions(200,200),
- image_min_dimensions(100,100),
- ],
- }
+ # In a Data::FormValidator Profile:
+ constraint_methods => {
+ image_name => [
+ file_format(),
+ file_max_bytes(10),
+ image_max_dimensions(200,200),
+ image_min_dimensions(100,100),
+ ],
+ }
=head1 DESCRIPTION
-B<Note:> This is a new module is a new addition to Data::FormValidator and is
-should be considered "Beta".
+B<Note:> This is a new module is a new addition to Data::FormValidator and is
+should be considered "Beta".
These module is meant to be used in conjunction with the Data::FormValidator
module to automate the task of validating uploaded files. The following
@@ -431,7 +431,7 @@ it checks to make sure files are smaller than 1 Meg. The params are:
reference to max file size in bytes
- file_max_bytes(1024), # 1 k
+ file_max_bytes(1024), # 1 k
Calling this function sets some meta data which can be retrieved through
the C<meta()> method of the Data::FormValidator::Results object.
@@ -440,7 +440,7 @@ The meta data added is C<bytes>.
=item image_max_dimensions
This function checks to make sure an uploaded image is no longer than
-some maximum dimensions. The params are:
+some maximum dimensions. The params are:
reference to max pixel width
reference to max pixel height
@@ -454,7 +454,7 @@ The meta data added is C<width> and C<height>.
=item image_min_dimensions
This function checks to make sure an uploaded image is longer than
-some minimum dimensions. The params are:
+some minimum dimensions. The params are:
reference to min pixel width
reference to min pixel height
@@ -474,17 +474,17 @@ To use it, you have to load the package with 'validator_packages', and call each
constraint in a hashref style, passing the the parameters by reference. It looks
like this:
- validator_packages => [qw(Data::FormValidator::Constraints::Upload)],
- constraints => {
- image_name => [
- {
- constraint_method => 'image_max_dimensions',
- params => [\200,\200],
- }
- ],
- }
-
-I told you it was more awkward. That was before I grokked the magic of closures, which
+ validator_packages => [qw(Data::FormValidator::Constraints::Upload)],
+ constraints => {
+ image_name => [
+ {
+ constraint_method => 'image_max_dimensions',
+ params => [\200,\200],
+ }
+ ],
+ }
+
+I told you it was more awkward. That was before I grokked the magic of closures, which
is what drives the current interface.
=head1 SEE ALSO
@@ -500,6 +500,6 @@ Mark Stosberg, E<lt>mark@summersault.comE<gt>
Copyright 2003-2005 by Mark Stosberg
This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+it under the same terms as Perl itself.
=cut
@@ -3,18 +3,18 @@
#
# This file is part of Data::FormValidator.
#
-# Author: Francis J. Lacoste
+# Author: Francis J. Lacoste
# Maintainer: Mark Stosberg <mark@summersault.com>
#
# Copyright (C) 1999,2000 iNsu Innovations Inc.
# Copyright (C) 2001 Francis J. Lacoste
-# Parts Copyright 1996-1999 by Michael J. Heins
-# Parts Copyright 1996-1999 by Bruce Albrecht
+# Parts Copyright 1996-1999 by Michael J. Heins
+# Parts Copyright 1996-1999 by Bruce Albrecht
#
# Parts of this module are based on work by
# Bruce Albrecht, contributed to MiniVend.
#
-# Parts also based on work by Michael J. Heins
+# Parts also based on work by Michael J. Heins
#
# This program is free software; you can redistribute it and/or modify
# it under the terms same terms as perl itself.
@@ -23,7 +23,7 @@ package Data::FormValidator::Constraints;
use strict;
use vars qw/$AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS $VERSION/;
-$VERSION = 4.63;
+$VERSION = 4.65;
require Exporter;
@ISA = qw(Exporter);
@@ -46,21 +46,21 @@ BEGIN {
zip_or_postcode/);
# This be optimized with some of the voodoo that CGI.pm
- # uses to AUTOLOAD dynamic functions.
+ # uses to AUTOLOAD dynamic functions.
for my $func (@closures) {
# cc_number is defined statically
unless ($func eq 'cc_number') {
# Notice we have to escape some characters
- # in the subroutine, which is really a string here.
+ # in the subroutine, which is really a string here.
local $SIG{__DIE__} = \&confess;
my $code = qq!
sub $func {
return sub {
my \$dfv = shift;
- use Scalar::Util ();
- die "first arg to $func was not an object. Must be called as a constraint_method."
- unless ( Scalar::Util::blessed(\$dfv) && \$dfv->can('name_this') );
+ use Scalar::Util ();
+ die "first arg to $func was not an object. Must be called as a constraint_method."
+ unless ( Scalar::Util::blessed(\$dfv) && \$dfv->can('name_this') );
\$dfv->name_this('$func');
no strict 'refs';
@@ -114,9 +114,9 @@ BEGIN {
);
%EXPORT_TAGS = (
- # regexp common is correctly empty here, because we handle the case on the fly with the import function below.
+ # regexp common is correctly empty here, because we handle the case on the fly with the import function below.
regexp_common => [],
- closures => [ @closures, @FVs ],
+ closures => [ @closures, @FVs ],
validators => [qw/
valid_american_phone
valid_cc_exp
@@ -146,14 +146,14 @@ BEGIN {
match_state_or_province
match_zip
match_zip_or_postcode
- /],
+ /],
);
sub import {
# This is Regexp::Common support.
# Here we are handling cases that look like this:
#
- # my_field => FV_foo_bar(-zoo=>'queue'),
+ # my_field => FV_foo_bar(-zoo=>'queue'),
if (grep { m/^:regexp_common$/ } @_) {
require Regexp::Common;
import Regexp::Common 'RE_ALL';
@@ -198,17 +198,17 @@ Data::FormValidator::Constraints - Basic sets of constraints on input profile.
In an Data::FormValidator profile:
constraint_methods => {
- email => email(),
- fax => american_phone(),
- phone => american_phone(),
- state => state(),
- },
+ email => email(),
+ fax => american_phone(),
+ phone => american_phone(),
+ state => state(),
+ },
=head1 DESCRIPTION
These are the builtin constraints that can be specified by name in the input
-profiles.
+profiles.
Be sure to check out the SEE ALSO section for even more pre-packaged
constraints you can use.
@@ -218,22 +218,22 @@ constraints you can use.
sub AUTOLOAD {
my $name = $AUTOLOAD;
- no strict qw/refs/;
+ no strict qw/refs/;
- $name =~ m/^(.*::)(valid_|RE_)(.*)/;
+ $name =~ m/^(.*::)(valid_|RE_)(.*)/;
- my ($pkg,$prefix,$sub) = ($1,$2,$3);
+ my ($pkg,$prefix,$sub) = ($1,$2,$3);
- #warn "hello! my ($pkg,$prefix,$sub) = ($1,$2,$3);";
+ #warn "hello! my ($pkg,$prefix,$sub) = ($1,$2,$3);";
# Since all the valid_* routines are essentially identical we're
# going to generate them dynamically from match_ routines with the same names.
- if ((defined $prefix) and ($prefix eq 'valid_')) {
- return defined &{$pkg.'match_' . $sub}(@_);
+ if ((defined $prefix) and ($prefix eq 'valid_')) {
+ return defined &{$pkg.'match_' . $sub}(@_);
}
}
-=head2 FV_length_between(1,23)
+=head2 FV_length_between(1,23)
=head2 FV_max_length(23)
@@ -252,20 +252,20 @@ sub AUTOLOAD {
}
-Specify a length constraint for a field.
+Specify a length constraint for a field.
These constraints have a different naming convention because they are higher-order
functions. They take input and return a code reference to a standard constraint
method. A constraint name of C<length_between>, C<min_length>, or C<max_length> will be set,
-corresponding to the function name you choose.
+corresponding to the function name you choose.
-The checks are all inclusive, so a max length of '100' will allow the length 100.
+The checks are all inclusive, so a max length of '100' will allow the length 100.
Length is measured in perl characters as opposed to bytes or anything else.
This constraint I<will> untaint your data if you have untainting turned on. However,
a length check alone may not be enough to insure the safety of the data you are receiving.
-Using additional constraints to check the data is encouraged.
+Using additional constraints to check the data is encouraged.
=cut
@@ -279,7 +279,7 @@ sub FV_length_between {
$dfv->name_this('length_between');
return undef if ( ( length($value) > $max ) || ( length($value) < $min) );
# Use a regexp to untaint
- $value=~/(.*)/;
+ $value=~/(.*)/s;
return $dfv->untainted_constraint_value($1);
}
}
@@ -292,7 +292,7 @@ sub FV_max_length {
$dfv->name_this('max_length');
return undef if ( length($value) > $max );
# Use a regexp to untaint
- $value=~/(.*)/;
+ $value=~/(.*)/s;
return $dfv->untainted_constraint_value($1);
}
}
@@ -305,16 +305,16 @@ sub FV_min_length {
$dfv->name_this('min_length');
return undef if ( length($value) < $min );
# Use a regexp to untaint
- $value=~/(.*)/;
+ $value=~/(.*)/s;
return $dfv->untainted_constraint_value($1);
}
}
-=head2 FV_eq_with
+=head2 FV_eq_with
use Data::FormValidator::Constraints qw( FV_eq_with );
- constraint_methods => {
+ constraint_methods => {
password => FV_eq_with('password_confirm'),
}
@@ -344,7 +344,7 @@ sub FV_eq_with {
=head2 email
Checks if the email LOOKS LIKE an email address. This should be sufficient
-99% of the time.
+99% of the time.
Look elsewhere if you want something super fancy that matches every possible variation
that is valid in the RFC, or runs out and checks some MX records.
@@ -359,12 +359,12 @@ sub match_email {
my $in_email = shift;
require Email::Valid;
- my $valid_email;
+ my $valid_email;
# The extra check that the result matches the input prevents
# an address like this from being considered valid: Joe Smith <joe@smith.com>
if ( ($valid_email = Email::Valid->address($in_email) )
- and ($valid_email eq $in_email)) {
+ and ($valid_email eq $in_email)) {
return $valid_email;
}
else {
@@ -391,17 +391,17 @@ province.
sub match_state_or_province {
my $match;
- if ($match = match_state(@_)) {
- return $match;
- }
+ if ($match = match_state(@_)) {
+ return $match;
+ }
else {
- return match_province(@_);
- }
+ return match_province(@_);
+ }
}
=head2 state
-This one checks if the input is a valid two letter abbreviation of an
+This one checks if the input is a valid two letter abbreviation of an
American state.
=cut
@@ -409,7 +409,7 @@ American state.
sub match_state {
my $val = shift;
if ($state =~ /\b($val)\b/i) {
- return $1;
+ return $1;
}
else { return undef; }
}
@@ -424,7 +424,7 @@ abbreviation.
sub match_province {
my $val = shift;
if ($province =~ /\b($val)\b/i) {
- return $1;
+ return $1;
}
else { return undef; }
}
@@ -438,12 +438,12 @@ Canadian postal code.
sub match_zip_or_postcode {
my $match;
- if ($match = match_zip(@_)) {
- return $match;
- }
+ if ($match = match_zip(@_)) {
+ return $match;
+ }
else {
- return match_postcode(@_)
- };
+ return match_postcode(@_)
+ };
}
=pod
@@ -457,7 +457,7 @@ sub match_postcode {
my $val = shift;
#$val =~ s/[_\W]+//g;
if ($val =~ /^([ABCEGHJKLMNPRSTVXYabceghjklmnprstvxy][_\W]*\d[_\W]*[A-Za-z][_\W]*[- ]?[_\W]*\d[_\W]*[A-Za-z][_\W]*\d[_\W]*)$/) {
- return $1;
+ return $1;
}
else { return undef; }
}
@@ -472,7 +472,7 @@ This input validator checks if the input is a valid american zipcode :
sub match_zip {
my $val = shift;
if ($val =~ /^(\s*\d{5}(?:[-]\d{4})?\s*)$/) {
- return $1;
+ return $1;
}
else { return undef; }
}
@@ -488,7 +488,7 @@ sub match_phone {
my $val = shift;
if ($val =~ /^((?:\D*\d\D*){6,})$/) {
- return $1;
+ return $1;
}
else { return undef; }
}
@@ -504,7 +504,7 @@ sub match_american_phone {
my $val = shift;
if ($val =~ /^((?:\D*\d\D*){7,})$/) {
- return $1;
+ return $1;
}
else { return undef; }
}
@@ -528,12 +528,12 @@ CHECK IF THERE IS AN ACCOUNT ASSOCIATED WITH THE NUMBER.
=cut
-# This one is taken from the contributed program to
+# This one is taken from the contributed program to
# MiniVend by Bruce Albrecht
# XXX raise exception on bad/missing params?
sub cc_number {
- my $attrs = shift;
+ my $attrs = shift;
return undef unless $attrs && ref($attrs) eq 'HASH'
&& exists $attrs->{fields} && ref($attrs->{fields}) eq 'ARRAY';
@@ -544,7 +544,7 @@ sub cc_number {
my $dfv = shift;
my $data = $dfv->get_filtered_data;
- return match_cc_number(
+ return match_cc_number(
$dfv->get_current_constraint_value,
$data->{$cc_type_field}
);
@@ -565,9 +565,9 @@ sub match_cc_number {
return undef if ($card_type =~ /^v/i && substr($the_card, 0, 1) ne "4") ||
($card_type =~ /^m/i && substr($the_card, 0, 1) ne "5") ||
- ($card_type =~ /^d/i && substr($the_card, 0, 4) ne "6011") ||
- ($card_type =~ /^a/i && substr($the_card, 0, 2) ne "34" &&
- substr($the_card, 0, 2) ne "37");
+ ($card_type =~ /^d/i && substr($the_card, 0, 4) ne "6011") ||
+ ($card_type =~ /^a/i && substr($the_card, 0, 2) ne "34" &&
+ substr($the_card, 0, 2) ne "37");
# check for valid number of digits.
$the_card =~ s/\s//g; # strip out spaces
@@ -594,11 +594,11 @@ sub match_cc_number {
# return whether checksum matched.
if ($the_sum == substr($the_card, -1)) {
- if ($orig_card =~ /^([\d\s]*)$/) { return $1; }
- else { return undef; }
+ if ($orig_card =~ /^([\d\s]*)$/) { return $1; }
+ else { return undef; }
}
else {
- return undef;
+ return undef;
}
}
@@ -645,9 +645,9 @@ sub match_cc_type {
=head2 ip_address
This checks if the input is formatted like a dotted decimal IP address (v4).
-For other kinds of IP address method, See L<Regexp::Common::net> which provides
+For other kinds of IP address method, See L<Regexp::Common::net> which provides
several more options. L<REGEXP::COMMON SUPPORT> explains how we easily integrate
-with Regexp::Common.
+with Regexp::Common.
=cut
@@ -656,10 +656,10 @@ with Regexp::Common.
sub match_ip_address {
my $val = shift;
if ($val =~ m/^((\d+)\.(\d+)\.(\d+)\.(\d+))$/) {
- if
- (($2 >= 0 && $2 <= 255) && ($3 >= 0 && $3 <= 255) && ($4 >= 0 && $4 <= 255) && ($5 >= 0 && $5 <= 255)) {
- return $1;
- }
+ if
+ (($2 >= 0 && $2 <= 255) && ($3 >= 0 && $3 <= 255) && ($4 >= 0 && $4 <= 255) && ($5 >= 0 && $5 <= 255)) {
+ return $1;
+ }
else { return undef; }
}
else { return undef; }
@@ -679,16 +679,16 @@ This works whether you want to untaint the data or not. For example:
use Data::FormValidator::Constraints qw(:regexp_common);
constraint_methods => {
- my_ip_address => FV_net_IPv4(),
+ my_ip_address => FV_net_IPv4(),
- # An example with parameters
- other_ip => FV_net_IPv4(-sep=>' '),
+ # An example with parameters
+ other_ip => FV_net_IPv4(-sep=>' '),
}
-Notice that the routines are named with the prefix "FV_" instead of "RE_" now.
+Notice that the routines are named with the prefix "FV_" instead of "RE_" now.
This is simply a visual cue that these are slightly modified versions. We've made
-a wrapper for each Regexp::Common routine so that it can be used as a named constraint
-like this.
+a wrapper for each Regexp::Common routine so that it can be used as a named constraint
+like this.
Be sure to check out the L<Regexp::Common> syntax for how its syntax works. It
will make more sense to add future regular expressions to Regexp::Common rather
@@ -699,7 +699,7 @@ than to Data::FormValidator.
You may also call these functions directly through the procedural interface by
either importing them directly or importing the whole I<:validators> group.
This is useful if you want to use the built-in validators out of the usual
-profile specification interface.
+profile specification interface.
For example, if you want to access the I<email> validator
@@ -714,7 +714,7 @@ directly, you could either do:
}
Notice that when you call validators directly, you'll need to prefix the
-validator name with "valid_"
+validator name with "valid_"
Each validator also has a version that returns the untainted value if
the validation succeeded. You may call these functions directly
@@ -730,7 +730,7 @@ value with the I<email> validator directly you may:
}
Notice that when you call validators directly and want them to return an
-untainted value, you'll need to prefix the validator name with "match_"
+untainted value, you'll need to prefix the validator name with "match_"
=pod
@@ -743,57 +743,57 @@ This is the current recommended way to write constraints. See also L<Old School
The most flexible way to create constraints to use closures-- a normal seeming
outer subroutine which returns a customized DFV method subroutine as a result.
It's easy to do. These "constraint methods" can be named whatever you like, and
-imported normally into the name space where the profile is located.
+imported normally into the name space where the profile is located.
-Let's look at an example.
+Let's look at an example.
- # Near your profile
+ # Near your profile
# Of course, you don't have to export/import if your constraints are in the same
- # package as the profile.
+ # package as the profile.
use My::Constraints 'coolness';
# In your profile
constraint_methods => {
- email => email(),
- prospective_date => coolness( 40, 60,
- {fields => [qw/personality smarts good_looks/]}
- ),
+ email => email(),
+ prospective_date => coolness( 40, 60,
+ {fields => [qw/personality smarts good_looks/]}
+ ),
}
-Let's look at how this complex C<coolness> constraint method works. The
+Let's look at how this complex C<coolness> constraint method works. The
interface asks for users to define minimum and maximum coolness values, as
-well as declaring three data field names that we should peek into to look
-their values.
+well as declaring three data field names that we should peek into to look
+their values.
Here's what the code might look like:
sub coolness {
- my ($min_cool,$max_cool, $attrs) = @_;
- my ($personality,$smarts,$looks) = @{ $attrs->{fields} } if $attrs->{fields};
- return sub {
- my $dfv = shift;
+ my ($min_cool,$max_cool, $attrs) = @_;
+ my ($personality,$smarts,$looks) = @{ $attrs->{fields} } if $attrs->{fields};
+ return sub {
+ my $dfv = shift;
- # Name it to refer to in the 'msgs' system.
- $dfv->name_this('coolness');
+ # Name it to refer to in the 'msgs' system.
+ $dfv->name_this('coolness');
# value of 'prospective_date' parameter
- my $val = $dfv->get_current_constraint_value();
+ my $val = $dfv->get_current_constraint_value();
- # get other data to refer to
- my $data = $dfv->get_filtered_data;
+ # get other data to refer to
+ my $data = $dfv->get_filtered_data;
- my $has_all_three = ($data->{$personality} && $data->{$smarts} && $data->{$looks});
- return ( ($val >= $min_cool) && ($val <= $max_cool) && $has_all_three );
- }
+ my $has_all_three = ($data->{$personality} && $data->{$smarts} && $data->{$looks});
+ return ( ($val >= $min_cool) && ($val <= $max_cool) && $has_all_three );
+ }
}
=head2 Old School Constraints
Here is documentation on how old school constraints are created. These are
-supported, but the the new school style documented above is recommended.
+supported, but the the new school style documented above is recommended.
-See also the C<validator_packages> option in the input profile, for loading
-sets of old school constraints from other packages.
+See also the C<validator_packages> option in the input profile, for loading
+sets of old school constraints from other packages.
Old school constraint routines are named two ways. Some are named with the
prefix C<match_> while others start with C<valid_>. The difference is that the
@@ -804,17 +804,17 @@ validation succeeds and false otherwise.
It is preferable to write C<match_> routines that untaint data for the extra
security benefits. Plus, Data::FormValidator will AUTOLOAD a C<valid_> version
if anyone tries to use it, so you only need to write one routine to cover both
-cases.
+cases.
Usually constraint routines only need one input, the value being specified.
-However, sometimes more than one value is needed.
+However, sometimes more than one value is needed.
B<Example>:
- image_field => {
- constraint_method => 'max_image_dimensions',
- params => [\100,\200],
- },
+ image_field => {
+ constraint_method => 'max_image_dimensions',
+ params => [\100,\200],
+ },
Using that syntax, the first parameter that will be passed to the routine is
the Data::FormValidator object. The remaining parameters will come from the
@@ -835,8 +835,8 @@ available to you to use inside of your routine.
=head3 get_input_data()
-Returns the raw input data. This may be a CGI object if that's what
-was used in the constraint routine.
+Returns the raw input data. This may be a CGI object if that's what
+was used in the constraint routine.
B<Examples:>
@@ -851,8 +851,8 @@ B<Examples:>
my $data = $self->get_filtered_data;
Returns the valid filtered data as a hashref, regardless of whether
-it started out as a CGI.pm compatible object. Multiple values are
-expressed as array references.
+it started out as a CGI.pm compatible object. Multiple values are
+expressed as array references.
=head3 get_current_constraint_field()
@@ -896,7 +896,7 @@ regular expressions.
If you have written a constraint which untaints, use this method to return the
untainted result. It will prepare the right result whether the user has requested
-untainting or not.
+untainting or not.
=head3 name_this()
@@ -907,13 +907,13 @@ Sets the name of the current constraint being applied.
B<Example>:
sub my_constraint {
- my @outer_params = @_;
- return sub {
- my $dfv = shift;
- $dfv->set_current_constraint_name('my_constraint');
- my @params = @outer_params;
- # do something constraining here...
- }
+ my @outer_params = @_;
+ return sub {
+ my $dfv = shift;
+ $dfv->set_current_constraint_name('my_constraint');
+ my @params = @outer_params;
+ # do something constraining here...
+ }
}
By returning a closure which uses this method, you can build an advanced named
@@ -930,26 +930,26 @@ of that method.
=head1 BACKWARDS COMPATIBILITY
Prior to Data::FormValidator 4.00, constraints were specified a bit differently.
-This older style is still supported.
+This older style is still supported.
It was not necessary to explicitly load some constraints into your name space,
and the names were given as strings, like this:
constraints => {
- email => 'email',
- fax => 'american_phone',
- phone => 'american_phone',
- state => 'state',
- my_ip_address => 'RE_net_IPv4',
- other_ip => {
- constraint => 'RE_net_IPv4',
- params => [ \'-sep'=> \' ' ],
- },
- my_cc_no => {
- constraint => 'cc_number',
- params => [qw/cc_no cc_type/],
- }
- },
+ email => 'email',
+ fax => 'american_phone',
+ phone => 'american_phone',
+ state => 'state',
+ my_ip_address => 'RE_net_IPv4',
+ other_ip => {
+ constraint => 'RE_net_IPv4',
+ params => [ \'-sep'=> \' ' ],
+ },
+ my_cc_no => {
+ constraint => 'cc_number',
+ params => [qw/cc_no cc_type/],
+ }
+ },
=head1 SEE ALSO
@@ -960,14 +960,14 @@ and the names were given as strings, like this:
=item L<Data::FormValidator::Constraints::Upload> - validate the bytes, format and dimensions of file uploads
-=item L<Data::FormValidator::Constraints::DateTime> - A newer DateTime constraint module. May save you a step of transforming the date into a more useful format after it's validated.
+=item L<Data::FormValidator::Constraints::DateTime> - A newer DateTime constraint module. May save you a step of transforming the date into a more useful format after it's validated.
=item L<Data::FormValidator::Constraints::Dates> - the original DFV date constraint module. Try the newer one first!
=item L<Data::FormValidator::Constraints::Japanese> - Japan-specific constraints
=item L<Data::FormValidator::Constraints::MethodsFactory> - a useful collection of tools generate more complex constraints. Recommended!
-
+
=back
@@ -994,9 +994,9 @@ Bruce Albrecht to the MiniVend program.
=head1 AUTHORS
- Francis J. Lacoste
- Michael J. Heins
- Bruce Albrecht
+ Francis J. Lacoste
+ Michael J. Heins
+ Bruce Albrecht
Mark Stosberg
=head1 COPYRIGHT
@@ -1004,9 +1004,9 @@ Bruce Albrecht to the MiniVend program.
Copyright (c) 1999 iNsu Innovations Inc.
All rights reserved.
-Parts Copyright 1996-1999 by Michael J. Heins
-Parts Copyright 1996-1999 by Bruce Albrecht
-Parts Copyright 2005 by Mark Stosberg
+Parts Copyright 1996-1999 by Michael J. Heins
+Parts Copyright 1996-1999 by Bruce Albrecht
+Parts Copyright 2005-2009 by Mark Stosberg
This program is free software; you can redistribute it and/or modify
it under the terms as perl itself.
@@ -23,22 +23,22 @@ Data::FormValidator::ConstraintsFactory - Module to create constraints for HTML:
=head1 DESCRIPTION
-This module contains functions to help generate complex constraints.
+This module contains functions to help generate complex constraints.
If you are writing new code, take a look at L<Data::FormValidator::Constraints::MethodsFactory>
-instead. It's a modern alternative to what's here, offering improved names and syntax.
+instead. It's a modern alternative to what's here, offering improved names and syntax.
=head1 SYNOPSIS
use Data::FormValidator::ConstraintsFactory qw( :set :bool );
constraints => {
- param1 => make_or_constraint(
- make_num_set_constraint( -1, ( 1 .. 10 ) ),
- make_set_constraint( 1, ( 20 .. 30 ) ),
- ),
- province => make_word_set_constraint( 1, "AB QC ON TN NU" ),
- bid => make_range_constraint( 1, 1, 10 ),
+ param1 => make_or_constraint(
+ make_num_set_constraint( -1, ( 1 .. 10 ) ),
+ make_set_constraint( 1, ( 20 .. 30 ) ),
+ ),
+ province => make_word_set_constraint( 1, "AB QC ON TN NU" ),
+ bid => make_range_constraint( 1, 1, 10 ),
}
=cut
@@ -48,22 +48,22 @@ use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
BEGIN {
require Exporter;
- $VERSION = 1.7;
+ $VERSION = 1.7;
@ISA = qw( Exporter );
@EXPORT = ();
@EXPORT_OK = (qw/make_length_constraint/);
- %EXPORT_TAGS =
+ %EXPORT_TAGS =
(
bool => [ qw( make_not_constraint make_or_constraint
- make_and_constraint ) ],
+ make_and_constraint ) ],
set => [ qw( make_set_constraint make_num_set_constraint
- make_word_set_constraint make_cmp_set_constraint ) ],
+ make_word_set_constraint make_cmp_set_constraint ) ],
num => [ qw( make_clamp_constraint make_lt_constraint
- make_le_constraint make_gt_constraint
- make_ge_constraint ) ],
+ make_le_constraint make_gt_constraint
+ make_ge_constraint ) ],
);
Exporter::export_ok_tags( 'bool' );
@@ -102,12 +102,12 @@ sub make_or_constraint {
my @c = @_;
# Closure
return sub {
- my $res;
- for my $c ( @c ) {
- $res = $c->( @_ );
- return $res if $res;
- }
- return $res;
+ my $res;
+ for my $c ( @c ) {
+ $res = $c->( @_ );
+ return $res if $res;
+ }
+ return $res;
};
}
@@ -124,14 +124,14 @@ sub make_and_constraint {
# Closure
return sub {
- my $res;
- for my $c ( @c ) {
- $res = $c->( @_ );
- return $res if ! $res;
-
- $res ||= $res;
- }
- return $res;
+ my $res;
+ for my $c ( @c ) {
+ $res = $c->( @_ );
+ return $res if ! $res;
+
+ $res ||= $res;
+ }
+ return $res;
};
}
@@ -156,11 +156,11 @@ sub make_set_constraint {
# Closure
return sub {
- my $v = $_[0];
- for my $t ( @values ) {
- return $res if $t eq $v;
- }
- return ! $res;
+ my $v = $_[0];
+ for my $t ( @values ) {
+ return $res if $t eq $v;
+ }
+ return ! $res;
}
}
@@ -179,11 +179,11 @@ sub make_num_set_constraint {
# Closure
return sub {
- my $v = $_[0];
- for my $t ( @values ) {
- return $res if $t == $v;
- }
- return ! $res;
+ my $v = $_[0];
+ for my $t ( @values ) {
+ return $res if $t == $v;
+ }
+ return ! $res;
}
}
@@ -199,12 +199,12 @@ sub make_word_set_constraint {
# Closure
return sub {
- my $v = $_[0];
- if ( $set =~ /\b$v\b/i ) {
- return $res;
- } else {
- return ! $res;
- }
+ my $v = $_[0];
+ if ( $set =~ /\b$v\b/i ) {
+ return $res;
+ } else {
+ return ! $res;
+ }
}
}
@@ -224,11 +224,11 @@ sub make_match_set_constraint {
# Closure
return sub {
- my $v = $_[0];
- for my $t ( @values ) {
- return $res if $cmp->($v, $t );
- }
- return ! $res;
+ my $v = $_[0];
+ for my $t ( @values ) {
+ return $res if $cmp->($v, $t );
+ }
+ return ! $res;
}
}
@@ -249,8 +249,8 @@ sub make_clamp_constraint {
my ( $res, $low, $high ) = @_;
return sub {
- my $v = $_[0];
- $v < $low || $v > $high ? ! $res : $res;
+ my $v = $_[0];
+ $v < $low || $v > $high ? ! $res : $res;
}
}
@@ -265,7 +265,7 @@ sub make_lt_constraint {
my ( $res, $bound ) = @_;
return sub {
- $_[0] < $bound ? $res : ! $res;
+ $_[0] < $bound ? $res : ! $res;
}
}
@@ -280,7 +280,7 @@ sub make_le_constraint {
my ( $res, $bound ) = @_;
return sub {
- $_[0] <= $bound ? $res : ! $res;
+ $_[0] <= $bound ? $res : ! $res;
}
}
@@ -295,7 +295,7 @@ sub make_gt_constraint {
my ( $res, $bound ) = @_;
return sub {
- $_[0] >= $bound ? $res : ! $res;
+ $_[0] >= $bound ? $res : ! $res;
}
}
@@ -310,7 +310,7 @@ sub make_ge_constraint {
my ( $res, $bound ) = @_;
return sub {
- $_[0] >= $bound ? $res : ! $res;
+ $_[0] >= $bound ? $res : ! $res;
}
}
@@ -337,7 +337,7 @@ __END__
=head1 SEE ALSO
-Data::FormValidator(3)
+Data::FormValidator(3)
=head1 AUTHOR
@@ -6,36 +6,37 @@
#
# Copyright (C) 1999,2000 iNsu Innovations Inc.
#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms same terms as perl itself.
+# This program is free software; you can redistribute it and/or modify
+# it under the terms same terms as perl itself.
package Data::FormValidator::Filters;
use strict;
use vars qw/$AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS $VERSION/;
-$VERSION = 4.62;
+$VERSION = 4.65;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
filter_alphanum
- filter_decimal
- filter_digit
- filter_dollars
- filter_integer
- filter_lc
- filter_neg_decimal
- filter_neg_integer
- filter_phone
- filter_pos_decimal
- filter_pos_integer
- filter_quotemeta
- filter_sql_wildcard
- filter_strip
- filter_trim
- filter_uc
- filter_ucfirst
+ filter_decimal
+ filter_digit
+ filter_dollars
+ filter_integer
+ filter_lc
+ filter_neg_decimal
+ filter_neg_integer
+ filter_phone
+ filter_pos_decimal
+ filter_pos_integer
+ filter_quotemeta
+ filter_sql_wildcard
+ filter_strip
+ filter_trim
+ filter_uc
+ filter_ucfirst
FV_split
+ FV_replace
);
%EXPORT_TAGS = (
@@ -65,22 +66,22 @@ Data::FormValidator::Filters - Basic set of filters available in an Data::FormVa
These are the builtin filters which may be specified as a name in the
I<filters>, I<field_filters>, and I<field_filter_regexp_map> parameters of the
-input profile.
+input profile.
Filters are applied as the first step of validation, possibly modifying a copy
-of the validation before any constraints are checked.
+of the validation before any constraints are checked.
=head1 RECOMMENDED USE
As a long time maintainer and user of Data::FormValidator, I recommend that
filters be used with caution. They are immediately modifying the input
provided, so the original data is lost. The few I recommend include C<trim>,
-which removes leading and trailing whitespace. I have this turned on by default
+which removes leading and trailing whitespace. I have this turned on by default
by using L<CGI::Application::Plugin::ValidateRM>. It's also generally safe to use
-the C<lc> and C<uc> filters if you need that kind of data transformation.
+the C<lc> and C<uc> filters if you need that kind of data transformation.
Beyond simple filters, I recommend transforming the C<"valid"> hash returned
-from validation if further changes are needed.
+from validation if further changes are needed.
=head1 PROCEDURAL INTERFACE
@@ -104,12 +105,12 @@ Notice that when you call filters directly, you'll need to prefix the filter nam
use Data::FormValidator::Filters qw(FV_split);
- # Validate every e-mail in a comma separated list
+ # Validate every e-mail in a comma separated list
field_filters => {
several_emails => FV_split(qr/\s*,\s*/),
- # Any pattern that can be used by the 'split' builtin works.
+ # Any pattern that can be used by the 'split' builtin works.
tab_sep_field => FV_split('\t'),
},
constraint_methods => {
@@ -117,11 +118,11 @@ Notice that when you call filters directly, you'll need to prefix the filter nam
},
With this filter, you can split a field into multiple values. The constraint for
-the field will then be applied to every value.
+the field will then be applied to every value.
This filter has a different naming convention because it is a higher-order
function. Rather than returning a value directly, it returns a code reference
-to a standard Data::FormValidator filter.
+to a standard Data::FormValidator filter.
After successfully being validated the values will appear as an arrayref.
@@ -129,11 +130,37 @@ After successfully being validated the values will appear as an arrayref.
sub FV_split {
my $splitter = shift || die "nothing to split on!";
- return sub {
+ return sub {
my $value = shift;
return undef unless defined $value;
- my @a = split $splitter, $value;
- return \@a;
+ my @a = split $splitter, $value;
+ return \@a;
+ };
+}
+
+=head2 FV_replace
+
+ use Data::FormValidator::Filters qw(FV_replace);
+
+ field_filters => {
+ first_name => FV_replace(qr/Mark/,'Don'),
+ },
+
+FV_replace is a shorthand for writing simple find-and-replace filters.
+The above filter would be translated to this:
+
+ sub { my $v = shift; $v =~ s/Mark/Don/; $v }
+
+For more complex filters, just write your own.
+
+=cut
+
+sub FV_replace {
+ my ($find,$replace) = @_;
+ return sub {
+ my $v = shift;
+ $v =~ s/$find/$replace/;
+ return $v;
};
}
@@ -145,7 +172,7 @@ Remove white space at the front and end of the fields.
sub filter_trim {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
# Remove whitespace at the front
$value =~ s/^\s+//o;
@@ -166,7 +193,7 @@ Runs of white space are replaced by a single space.
sub filter_strip {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
# Strip whitespace
$value =~ s/\s+/ /g;
@@ -184,7 +211,7 @@ Remove non digits characters from the input.
sub filter_digit {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ s/\D//g;
@@ -201,7 +228,7 @@ Remove non alphanumeric characters from the input.
sub filter_alphanum {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ s/\W//g;
return $value;
}
@@ -216,7 +243,7 @@ Extract from its input a valid integer number.
sub filter_integer {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ tr/0-9+-//dc;
($value) =~ m/([-+]?\d+)/;
return $value;
@@ -234,7 +261,7 @@ Bugs: This filter won't extract "9" from "a9+", it will instead extract "9+"
sub filter_pos_integer {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ tr/0-9+//dc;
($value) =~ m/(\+?\d+)/;
return $value;
@@ -247,13 +274,13 @@ sub filter_pos_integer {
Extract from its input a valid negative integer number.
Bugs: This filter will currently filter the case of "a9-" to become "9-",
-which it should leave it alone.
+which it should leave it alone.
=cut
sub filter_neg_integer {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ tr/0-9-//dc;
($value) =~ m/(-\d+)/;
return $value;
@@ -271,7 +298,7 @@ Bugs: Given "1,000.23", it will currently return "1.000.23"
sub filter_decimal {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
# This is a localization problem, but anyhow...
$value =~ tr/,/./;
$value =~ tr/0-9.+-//dc;
@@ -291,7 +318,7 @@ Bugs: Given "1,000.23", it will currently return "1.000.23"
sub filter_pos_decimal {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
# This is a localization problem, but anyhow...
$value =~ tr/,/./;
$value =~ tr/0-9.+//dc;
@@ -311,7 +338,7 @@ Bugs: Given "1,000.23", it will currently return "1.000.23"
sub filter_neg_decimal {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
# This is a localization problem, but anyhow...
$value =~ tr/,/./;
$value =~ tr/0-9.-//dc;
@@ -331,7 +358,7 @@ Bugs: This filter won't currently remove trailing numbers like "1.234".
sub filter_dollars {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ tr/,/./;
$value =~ tr/0-9.+-//dc;
($value) =~ m/(\d+\.?\d?\d?)/;
@@ -349,7 +376,7 @@ accept digits [0-9], space, comma, minus, parenthesis, period and pound [#].)
sub filter_phone {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ s/[^\d,\(\)\.\s,\-#]//g;
return $value;
}
@@ -364,7 +391,7 @@ Transforms shell glob wildcard (*) to the SQL like wildcard (%).
sub filter_sql_wildcard {
my $value = shift;
- return unless defined $value;
+ return unless defined $value;
$value =~ tr/*/%/;
return $value;
}
@@ -379,7 +406,7 @@ input.
=cut
sub filter_quotemeta {
- return unless defined $_[0];
+ return unless defined $_[0];
quotemeta $_[0];
}
@@ -392,7 +419,7 @@ Calls the lc (convert to lowercase) builtin on its input.
=cut
sub filter_lc {
- return unless defined $_[0];
+ return unless defined $_[0];
lc $_[0];
}
@@ -405,7 +432,7 @@ Calls the uc (convert to uppercase) builtin on its input.
=cut
sub filter_uc {
- return unless defined $_[0];
+ return unless defined $_[0];
uc $_[0];
}
@@ -418,7 +445,7 @@ Calls the ucfirst (Uppercase first letter) builtin on its input.
=cut
sub filter_ucfirst {
- return unless defined $_[0];
+ return unless defined $_[0];
ucfirst $_[0];
}
@@ -24,7 +24,7 @@ use overload
'bool' => \&_bool_overload_based_on_success,
fallback => 1;
-$VERSION = 4.62;
+$VERSION = 4.65;
=pod
@@ -34,27 +34,27 @@ Data::FormValidator::Results - results of form input validation.
=head1 SYNOPSIS
- my $results = Data::FormValidator->check(\%input_hash, \%dfv_profile);
+ my $results = Data::FormValidator->check(\%input_hash, \%dfv_profile);
# Print the name of missing fields
if ( $results->has_missing ) {
- for my $f ( $results->missing ) {
- print $f, " is missing\n";
- }
+ for my $f ( $results->missing ) {
+ print $f, " is missing\n";
+ }
}
# Print the name of invalid fields
if ( $results->has_invalid ) {
- for my $f ( $results->invalid ) {
- print $f, " is invalid: ", $results->invalid( $f ), "\n";
- }
+ for my $f ( $results->invalid ) {
+ print $f, " is invalid: ", $results->invalid( $f ), "\n";
+ }
}
# Print unknown fields
if ( $results->has_unknown ) {
- for my $f ( $results->unknown ) {
- print $f, " is unknown\n";
- }
+ for my $f ( $results->unknown ) {
+ print $f, " is unknown\n";
+ }
}
# Print valid fields
@@ -64,7 +64,7 @@ Data::FormValidator::Results - results of form input validation.
=head1 DESCRIPTION
-This object is returned by the L<Data::FormValidator> C<check> method.
+This object is returned by the L<Data::FormValidator> C<check> method.
It can be queried for information about the validation results.
=cut
@@ -84,142 +84,142 @@ sub new {
sub _process {
my ($self, $profile, $data) = @_;
- # Copy data and assumes that all is valid to start with
-
- my %data = $self->_get_input_as_hash($data);
- my %valid = %data;
+ # Copy data and assumes that all is valid to start with
+
+ my %data = $self->_get_input_as_hash($data);
+ my %valid = %data;
my @missings = ();
- my @unknown = ();
+ my @unknown = ();
- # msgs() method will need access to the profile
- $self->{profile} = $profile;
+ # msgs() method will need access to the profile
+ $self->{profile} = $profile;
- my %imported_validators;
+ my %imported_validators;
# import valid_* subs from requested packages
- for my $package (_arrayify($profile->{validator_packages})) {
- if ( !exists $imported_validators{$package} ) {
- local $SIG{__DIE__} = \&confess;
- eval "require $package";
- if ($@) {
- die "Couldn't load validator package '$package': $@";
- }
-
- # Perl will die with a nice error message if the package can't be found
- # No need to go through extra effort here. -mls :)
- my $package_ref = qualify_to_ref("${package}::");
- my @subs = grep(/^(valid_|match_|filter_)/,
- keys(%{*{$package_ref}}));
- for my $sub (@subs) {
- # is it a sub? (i.e. make sure it's not a scalar, hash, etc.)
- my $subref = *{qualify_to_ref("${package}::$sub")}{CODE};
- if (defined $subref) {
- *{qualify_to_ref($sub)} = $subref;
- }
- }
- $imported_validators{$package} = 1;
- }
- }
-
- # Apply unconditional filters
+ for my $package (_arrayify($profile->{validator_packages})) {
+ if ( !exists $imported_validators{$package} ) {
+ local $SIG{__DIE__} = \&confess;
+ eval "require $package";
+ if ($@) {
+ die "Couldn't load validator package '$package': $@";
+ }
+
+ # Perl will die with a nice error message if the package can't be found
+ # No need to go through extra effort here. -mls :)
+ my $package_ref = qualify_to_ref("${package}::");
+ my @subs = grep(/^(valid_|match_|filter_)/,
+ keys(%{*{$package_ref}}));
+ for my $sub (@subs) {
+ # is it a sub? (i.e. make sure it's not a scalar, hash, etc.)
+ my $subref = *{qualify_to_ref("${package}::$sub")}{CODE};
+ if (defined $subref) {
+ *{qualify_to_ref($sub)} = $subref;
+ }
+ }
+ $imported_validators{$package} = 1;
+ }
+ }
+
+ # Apply unconditional filters
for my $filter (_arrayify($profile->{filters})) {
- if (defined $filter) {
- # Qualify symbolic references
- $filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
- die "No filter found named: '$filter'";
- for my $field ( keys %valid ) {
- # apply filter, modifying %valid by reference, skipping undefined values
- _filter_apply(\%valid,$field,$filter);
- }
- }
+ if (defined $filter) {
+ # Qualify symbolic references
+ $filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
+ die "No filter found named: '$filter'";
+ for my $field ( keys %valid ) {
+ # apply filter, modifying %valid by reference, skipping undefined values
+ _filter_apply(\%valid,$field,$filter);
+ }
+ }
}
# Apply specific filters
while ( my ($field,$filters) = each %{$profile->{field_filters} }) {
- for my $filter ( _arrayify($filters)) {
- if (defined $filter) {
- # Qualify symbolic references
- $filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
- die "No filter found named '$filter'";
-
- # apply filter, modifying %valid by reference
- _filter_apply(\%valid,$field,$filter);
- }
- }
- }
-
- # add in specific filters from the regexp map
- while ( my ($re,$filters) = each %{$profile->{field_filter_regexp_map} }) {
- my $sub = _create_sub_from_RE($re);
-
- for my $filter ( _arrayify($filters)) {
- if (defined $filter) {
- # Qualify symbolic references
- $filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
- die "No filter found named '$filter'";
-
- no strict 'refs';
-
- # find all the keys that match this RE and apply filters to them
- for my $field (grep { $sub->($_) } (keys %valid)) {
- # apply filter, modifying %valid by reference
- _filter_apply(\%valid,$field,$filter);
- }
- }
- }
- }
-
+ for my $filter ( _arrayify($filters)) {
+ if (defined $filter) {
+ # Qualify symbolic references
+ $filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
+ die "No filter found named '$filter'";
+
+ # apply filter, modifying %valid by reference
+ _filter_apply(\%valid,$field,$filter);
+ }
+ }
+ }
+
+ # add in specific filters from the regexp map
+ while ( my ($re,$filters) = each %{$profile->{field_filter_regexp_map} }) {
+ my $sub = _create_sub_from_RE($re);
+
+ for my $filter ( _arrayify($filters)) {
+ if (defined $filter) {
+ # Qualify symbolic references
+ $filter = (ref $filter eq 'CODE' ? $filter : *{qualify_to_ref("filter_$filter")}{CODE}) ||
+ die "No filter found named '$filter'";
+
+ no strict 'refs';
+
+ # find all the keys that match this RE and apply filters to them
+ for my $field (grep { $sub->($_) } (keys %valid)) {
+ # apply filter, modifying %valid by reference
+ _filter_apply(\%valid,$field,$filter);
+ }
+ }
+ }
+ }
+
# store the filtered data away for later use
$self->{__FILTERED_DATA} = \%valid;
-
+
my %required = map { $_ => 1 } _arrayify($profile->{required});
my %optional = map { $_ => 1 } _arrayify($profile->{optional});
- # loop through and add fields to %required and %optional based on regular expressions
+ # loop through and add fields to %required and %optional based on regular expressions
my $required_re = _create_sub_from_RE($profile->{required_regexp});
my $optional_re = _create_sub_from_RE($profile->{optional_regexp});
for my $k (keys %valid) {
if ($required_re && $required_re->($k)) {
- $required{$k} = 1;
+ $required{$k} = 1;
}
-
+
if ($optional_re && $optional_re->($k)) {
- $optional{$k} = 1;
+ $optional{$k} = 1;
}
}
- # handle "require_some"
- my %require_some;
- while ( my ( $field, $deps) = each %{$profile->{require_some}} ) {
+ # handle "require_some"
+ my %require_some;
+ while ( my ( $field, $deps) = each %{$profile->{require_some}} ) {
for my $dep (_arrayify($deps)){
$require_some{$dep} = 1;
}
}
-
- # Remove all empty fields
- for my $field (keys %valid) {
- if (ref $valid{$field}) {
- if ( ref $valid{$field} eq 'ARRAY' ) {
- for (my $i = 0; $i < scalar @{ $valid{$field} }; $i++) {
- $valid{$field}->[$i] = undef unless (defined $valid{$field}->[$i] and length $valid{$field}->[$i] and $valid{$field}->[$i] !~ /^\x00$/);
- }
+
+ # Remove all empty fields
+ for my $field (keys %valid) {
+ if (ref $valid{$field}) {
+ if ( ref $valid{$field} eq 'ARRAY' ) {
+ for (my $i = 0; $i < scalar @{ $valid{$field} }; $i++) {
+ $valid{$field}->[$i] = undef unless (defined $valid{$field}->[$i] and length $valid{$field}->[$i] and $valid{$field}->[$i] !~ /^\x00$/);
+ }
# If all fields are empty, we delete it.
delete $valid{$field} unless grep { defined $_ } @{$valid{$field}};
- }
- }
- else {
- delete $valid{$field} unless (defined $valid{$field} and length $valid{$field} and $valid{$field} !~ /^\x00$/);
- }
- }
+ }
+ }
+ else {
+ delete $valid{$field} unless (defined $valid{$field} and length $valid{$field} and $valid{$field} !~ /^\x00$/);
+ }
+ }
# Check if the presence of some fields makes other optional fields required.
while ( my ( $field, $deps) = each %{$profile->{dependencies}} ) {
if (defined $valid{$field}) {
- if (ref($deps) eq 'HASH') {
- for my $key (keys %$deps) {
+ if (ref($deps) eq 'HASH') {
+ for my $key (keys %$deps) {
# Handle case of a key with a single value given as an arrayref
# There is probably a better, more general solution to this problem.
my $val_to_compare;
@@ -230,17 +230,17 @@ sub _process {
$val_to_compare = $valid{$field}
}
- if($val_to_compare eq $key){
- for my $dep (_arrayify($deps->{$key})){
- $required{$dep} = 1;
- }
- }
- }
- }
+ if($val_to_compare eq $key){
+ for my $dep (_arrayify($deps->{$key})){
+ $required{$dep} = 1;
+ }
+ }
+ }
+ }
elsif (ref $deps eq "CODE") {
for my $val (_arrayify($valid{$field})) {
my $returned_deps = $deps->($self, $val);
-
+
for my $dep (_arrayify($returned_deps)) {
$required{$dep} = 1;
}
@@ -259,10 +259,10 @@ sub _process {
for my $group (values %{ $profile->{dependency_groups} }) {
my $require_all = 0;
for my $field (_arrayify($group)) {
- $require_all = 1 if $valid{$field};
+ $require_all = 1 if $valid{$field};
}
if ($require_all) {
- map { $required{$_} = 1 } _arrayify($group);
+ map { $required{$_} = 1 } _arrayify($group);
}
}
@@ -270,24 +270,24 @@ sub _process {
@unknown =
grep { not (exists $optional{$_} or exists $required{$_} or exists $require_some{$_} ) } keys %valid;
# and remove them from the list
- for my $field ( @unknown ) {
- delete $valid{$field};
- }
+ for my $field ( @unknown ) {
+ delete $valid{$field};
+ }
# Add defaults from defaults_regexp_map
my %private_defaults;
my @all_possible = keys %optional, keys %required, keys %require_some;
while ( my ($re,$value) = each %{$profile->{defaults_regexp_map}} ) {
- # We only add defaults for known fields.
+ # We only add defaults for known fields.
for (@all_possible) {
$private_defaults{$_} = $value if m/$re/;
}
}
# Fill defaults
- my %combined_defaults = (
- %private_defaults,
- %{ $profile->{defaults} || {} }
+ my %combined_defaults = (
+ %private_defaults,
+ %{ $profile->{defaults} || {} }
);
while ( my ($field,$value) = each %combined_defaults ) {
unless(exists $valid{$field}) {
@@ -297,37 +297,37 @@ sub _process {
$valid{$field} = $value;
}
}
- }
+ }
# Check for required fields
for my $field ( keys %required ) {
push @missings, $field unless exists $valid{$field};
}
- # Check for the absence of require_some fields
- while ( my ( $field, $deps) = each %{$profile->{require_some}} ) {
- my $enough_required_fields = 0;
- my @deps = _arrayify($deps);
- # num fields to require is first element in array if looks like a digit, 1 otherwise.
- my $num_fields_to_require = ($deps[0] =~ m/^\d+$/) ? $deps[0] : 1;
- for my $dep (@deps){
- $enough_required_fields++ if exists $valid{$dep};
- }
- push @missings, $field unless ($enough_required_fields >= $num_fields_to_require);
- }
+ # Check for the absence of require_some fields
+ while ( my ( $field, $deps) = each %{$profile->{require_some}} ) {
+ my $enough_required_fields = 0;
+ my @deps = _arrayify($deps);
+ # num fields to require is first element in array if looks like a digit, 1 otherwise.
+ my $num_fields_to_require = ($deps[0] =~ m/^\d+$/) ? $deps[0] : 1;
+ for my $dep (@deps){
+ $enough_required_fields++ if exists $valid{$dep};
+ }
+ push @missings, $field unless ($enough_required_fields >= $num_fields_to_require);
+ }
# add in the constraints from the regexp maps
# We don't want to modify the profile, so we use a new variable.
- $profile->{constraints} ||= {};
- my $private_constraints = {
- %{ $profile->{constraints} },
- _add_constraints_from_map($profile,'constraint',\%valid),
- };
- $profile->{constraint_methods} ||= {};
- my $private_constraint_methods = {
- %{ $profile->{constraint_methods} },
- _add_constraints_from_map($profile,'constraint_method',\%valid),
- };
+ $profile->{constraints} ||= {};
+ my $private_constraints = {
+ %{ $profile->{constraints} },
+ _add_constraints_from_map($profile,'constraint',\%valid),
+ };
+ $profile->{constraint_methods} ||= {};
+ my $private_constraint_methods = {
+ %{ $profile->{constraint_methods} },
+ _add_constraints_from_map($profile,'constraint_method',\%valid),
+ };
#Decide which fields to untaint
my ($untaint_all, %untaint_hash);
@@ -357,40 +357,40 @@ sub _process {
for my $regex (@untaint_regexes) {
# look at both constraints and constraint_methods
for my $field (keys %$private_constraints, keys %$private_constraint_methods) {
- next if($untaint_hash{$field});
+ next if($untaint_hash{$field});
$untaint_hash{$field} = 1 if( $field =~ $regex );
}
}
}
}
elsif ((defined($profile->{untaint_all_constraints}))
- && ($profile->{untaint_all_constraints} == 1)) {
- $untaint_all = 1;
+ && ($profile->{untaint_all_constraints} == 1)) {
+ $untaint_all = 1;
}
- $self->_check_constraints($private_constraints,\%valid,$untaint_all,\%untaint_hash);
+ $self->_check_constraints($private_constraints,\%valid,$untaint_all,\%untaint_hash);
- my $force_method_p = 1;
- $self->_check_constraints($private_constraint_methods,\%valid,$untaint_all,\%untaint_hash, $force_method_p);
+ my $force_method_p = 1;
+ $self->_check_constraints($private_constraint_methods,\%valid,$untaint_all,\%untaint_hash, $force_method_p);
# add back in missing optional fields from the data hash if we need to
- for my $field ( keys %data ) {
- if ($profile->{missing_optional_valid} and $optional{$field} and (not exists $valid{$field})) {
- $valid{$field} = undef;
- }
- }
+ for my $field ( keys %data ) {
+ if ($profile->{missing_optional_valid} and $optional{$field} and (not exists $valid{$field})) {
+ $valid{$field} = undef;
+ }
+ }
# all invalid fields are removed from valid hash
- for my $field (keys %{ $self->{invalid} }) {
- delete $valid{$field};
+ for my $field (keys %{ $self->{invalid} }) {
+ delete $valid{$field};
}
- my ($missing,$invalid);
+ my ($missing,$invalid);
- $self->{valid} ||= {};
- $self->{valid} = { %valid , %{$self->{valid}} };
- $self->{missing} = { map { $_ => 1 } @missings };
- $self->{unknown} = { map { $_ => $data{$_} } @unknown };
+ $self->{valid} ||= {};
+ $self->{valid} = { %valid , %{$self->{valid}} };
+ $self->{missing} = { map { $_ => 1 } @missings };
+ $self->{unknown} = { map { $_ => $data{$_} } @unknown };
}
@@ -416,12 +416,12 @@ sub success {
=head1 valid( [[field] [, value]] );
-In an array context with no arguments, it returns the list of fields which
+In an array context with no arguments, it returns the list of fields which
contain valid values:
@all_valid_field_names = $r->valid;
-In a scalar context with no arguments, it returns an hash reference which
+In a scalar context with no arguments, it returns an hash reference which
contains the valid fields as keys and their input as values:
$all_valid_href = $r->valid;
@@ -432,7 +432,7 @@ array ref if the field had multiple values:
$value = $r->valid('field');
-If called with one argument in array context, it returns the values of C<field>
+If called with one argument in array context, it returns the values of C<field>
as an array:
@values = $r->valid('field');
@@ -446,17 +446,17 @@ See the L<Data::FormValidator::Constraints> documentation.
=cut
sub valid {
- my $self = shift;
- my $key = shift;
- my $val = shift;
- $self->{valid}{$key} = $val if defined $val;
+ my $self = shift;
+ my $key = shift;
+ my $val = shift;
+ $self->{valid}{$key} = $val if defined $val;
if (defined $key) {
return wantarray ? _arrayify($self->{valid}{$key}) : $self->{valid}{$key};
}
- # If we got this far, there were no arguments passed.
- return wantarray ? keys %{ $self->{valid} } : $self->{valid};
+ # If we got this far, there were no arguments passed.
+ return wantarray ? keys %{ $self->{valid} } : $self->{valid};
}
@@ -508,19 +508,19 @@ sub has_invalid {
=head1 invalid( [field] )
-In an array context, it returns the list of fields which contains invalid value.
+In an array context, it returns the list of fields which contains invalid value.
In a scalar context, it returns an hash reference which contains the invalid
fields as keys, and references to arrays of failed constraints as values.
-If called with an argument, it returns the reference to an array of failed
+If called with an argument, it returns the reference to an array of failed
constraints for C<field>.
=cut
sub invalid {
- my $self = shift;
- my $field = shift;
+ my $self = shift;
+ my $field = shift;
return $self->{invalid}{$field} if defined $field;
wantarray ? keys %{$self->{invalid}} : $self->{invalid};
@@ -543,8 +543,8 @@ sub has_unknown {
=head1 unknown( [field] )
-In an array context, it returns the list of fields which are unknown.
-In a scalar context, it returns an hash reference which contains the unknown
+In an array context, it returns the list of fields which are unknown.
+In a scalar context, it returns an hash reference which contains the unknown
fields and their values.
If called with an argument, it returns the value of that C<field> if it
@@ -582,7 +582,7 @@ many projects.
Controls passed into the <msgs> method will be applied first, followed by ones
applied in the profile. This allows you to keep the controls you pass to
-C<msgs> as "global" and override them in a specific profile if needed.
+C<msgs> as "global" and override them in a specific profile if needed.
=cut
@@ -598,69 +598,69 @@ sub msgs {
sub _generate_msgs {
- my $self = shift;
- my $controls = shift || {};
- if (defined $controls and ref $controls ne 'HASH') {
- die "$0: parameter passed to msgs must be a hash ref";
- }
+ my $self = shift;
+ my $controls = shift || {};
+ if (defined $controls and ref $controls ne 'HASH') {
+ die "$0: parameter passed to msgs must be a hash ref";
+ }
- # Allow msgs to be called more than one to accumulate error messages
- $self->{msgs} ||= {};
- $self->{profile}{msgs} ||= {};
- $self->{msgs} = { %{ $self->{msgs} }, %$controls };
+ # Allow msgs to be called more than one to accumulate error messages
+ $self->{msgs} ||= {};
+ $self->{profile}{msgs} ||= {};
+ $self->{msgs} = { %{ $self->{msgs} }, %$controls };
- # Legacy typo support.
+ # Legacy typo support.
for my $href ($self->{msgs}, $self->{profile}{msgs}) {
if (
- (not defined $href->{invalid_separator})
+ (not defined $href->{invalid_separator})
&& (defined $href->{invalid_seperator})
) {
$href->{invalid_separator} = $href->{invalid_seperator};
}
}
- my %profile = (
- prefix => '',
- missing => 'Missing',
- invalid => 'Invalid',
- invalid_separator => ' ',
-
- format => '<span style="color:red;font-weight:bold"><span class="dfv_errors">* %s</span></span>',
- %{ $self->{msgs} },
- %{ $self->{profile}{msgs} },
- );
-
-
- my %msgs = ();
-
- # Add invalid messages to hash
- # look at all the constraints, look up their messages (or provide a default)
- # add field + formatted constraint message to hash
- if ($self->has_invalid) {
- my $invalid = $self->invalid;
- for my $i ( keys %$invalid ) {
- $msgs{$i} = join $profile{invalid_separator}, map {
- _error_msg_fmt($profile{format},($profile{constraints}{$_} || $profile{invalid}))
- } @{ $invalid->{$i} };
- }
- }
-
- # Add missing messages, if any
- if ($self->has_missing) {
- my $missing = $self->missing;
- for my $m (@$missing) {
- $msgs{$m} = _error_msg_fmt($profile{format},$profile{missing});
- }
- }
-
- my $msgs_ref = prefix_hash($profile{prefix},\%msgs);
+ my %profile = (
+ prefix => '',
+ missing => 'Missing',
+ invalid => 'Invalid',
+ invalid_separator => ' ',
+
+ format => '<span style="color:red;font-weight:bold" class="dfv_errors">* %s</span>',
+ %{ $self->{msgs} },
+ %{ $self->{profile}{msgs} },
+ );
+
+
+ my %msgs = ();
+
+ # Add invalid messages to hash
+ # look at all the constraints, look up their messages (or provide a default)
+ # add field + formatted constraint message to hash
+ if ($self->has_invalid) {
+ my $invalid = $self->invalid;
+ for my $i ( keys %$invalid ) {
+ $msgs{$i} = join $profile{invalid_separator}, map {
+ _error_msg_fmt($profile{format},($profile{constraints}{$_} || $profile{invalid}))
+ } @{ $invalid->{$i} };
+ }
+ }
+
+ # Add missing messages, if any
+ if ($self->has_missing) {
+ my $missing = $self->missing;
+ for my $m (@$missing) {
+ $msgs{$m} = _error_msg_fmt($profile{format},$profile{missing});
+ }
+ }
+
+ my $msgs_ref = prefix_hash($profile{prefix},\%msgs);
if (! $self->success) {
- $msgs_ref->{ $profile{any_errors} } = 1 if defined $profile{any_errors};
+ $msgs_ref->{ $profile{any_errors} } = 1 if defined $profile{any_errors};
}
- return $msgs_ref;
+ return $msgs_ref;
}
@@ -679,81 +679,81 @@ also used to access this data. Here are some examples.
# To retrieve all meta data for a field:
$meta_href = $results->meta('img');
-
- # Access a particular piece:
+
+ # Access a particular piece:
$width = $results->meta('img')->{width};
-
+
Here's how to set some meta data. This is useful to know if you are
writing your own complex constraint.
- $self->meta('img', {
- width => '50',
- height => '60',
- });
+ $self->meta('img', {
+ width => '50',
+ height => '60',
+ });
-This function does not currently support multi-valued fields. If it
+This function does not currently support multi-valued fields. If it
does in the future, the above syntax will still work.
=cut
sub meta {
- my $self = shift;
- my $field = shift;
- my $data = shift;
+ my $self = shift;
+ my $field = shift;
+ my $data = shift;
- # initialize if it's the first call
- $self->{__META} ||= {};
+ # initialize if it's the first call
+ $self->{__META} ||= {};
- if ($data) {
- (ref $data eq 'HASH') or die 'meta: data passed not a hash ref';
+ if ($data) {
+ (ref $data eq 'HASH') or die 'meta: data passed not a hash ref';
$self->{__META}{$field} = $data;
- }
+ }
- # If we are passed a field, return data for that field
- if ($field) {
- return $self->{__META}{$field};
- }
- # Otherwise return a list of all fields that have meta data
- else {
- return keys %{ $self->{__META} };
- }
+ # If we are passed a field, return data for that field
+ if ($field) {
+ return $self->{__META}{$field};
+ }
+ # Otherwise return a list of all fields that have meta data
+ else {
+ return keys %{ $self->{__META} };
+ }
}
# These are documented in ::Constraints, in the section
# on writing your own routines. It was more intuitive
-# for the user to look there.
+# for the user to look there.
sub get_input_data {
- my $self = shift;
+ my $self = shift;
my %p = @_;
if ($p{as_hashref}) {
my %hash = $self->_get_input_as_hash( $self->{__INPUT_DATA} );
return \%hash;
}
else {
- return $self->{__INPUT_DATA};
+ return $self->{__INPUT_DATA};
}
}
sub get_filtered_data {
my $self = shift;
- return $self->{__FILTERED_DATA};
+ return $self->{__FILTERED_DATA};
}
sub get_current_constraint_field {
- my $self = shift;
- return $self->{__CURRENT_CONSTRAINT_FIELD};
+ my $self = shift;
+ return $self->{__CURRENT_CONSTRAINT_FIELD};
}
sub get_current_constraint_value {
- my $self = shift;
- return $self->{__CURRENT_CONSTRAINT_VALUE};
+ my $self = shift;
+ return $self->{__CURRENT_CONSTRAINT_VALUE};
}
sub get_current_constraint_name {
- my $self = shift;
- return $self->{__CURRENT_CONSTRAINT_NAME};
+ my $self = shift;
+ return $self->{__CURRENT_CONSTRAINT_NAME};
}
sub untainted_constraint_value {
@@ -765,29 +765,29 @@ sub untainted_constraint_value {
}
sub set_current_constraint_name {
- my $self = shift;
- my $value = shift;
- $self->{__CURRENT_CONSTRAINT_NAME} = $value;
-}
+ my $self = shift;
+ my $value = shift;
+ $self->{__CURRENT_CONSTRAINT_NAME} = $value;
+}
# same as above
sub name_this {
- my $self = shift;
- my $value = shift;
- $self->{__CURRENT_CONSTRAINT_NAME} = $value;
-}
+ my $self = shift;
+ my $value = shift;
+ $self->{__CURRENT_CONSTRAINT_NAME} = $value;
+}
# INPUT: prefix_string, hash reference
# Copies the hash and prefixes all keys with prefix_string
# OUTPUT: hash reference
sub prefix_hash {
- my ($pre,$href) = @_;
- die "prefix_hash: need two arguments" unless (scalar @_ == 2);
- die "prefix_hash: second argument must be a hash ref" unless (ref $href eq 'HASH');
- my %out;
- for (keys %$href) {
- $out{$pre.$_} = $href->{$_};
- }
- return \%out;
+ my ($pre,$href) = @_;
+ die "prefix_hash: need two arguments" unless (scalar @_ == 2);
+ die "prefix_hash: second argument must be a hash ref" unless (ref $href eq 'HASH');
+ my %out;
+ for (keys %$href) {
+ $out{$pre.$_} = $href->{$_};
+ }
+ return \%out;
}
@@ -796,29 +796,29 @@ sub prefix_hash {
# Also, we accept the deprecated format given as strings: 'm/old/'
# (which must start with a slash or "m", not a paren)
sub _create_sub_from_RE {
- my $re = shift || return undef;
- my $untaint_this = shift;
+ my $re = shift || return undef;
+ my $untaint_this = shift;
my $force_method_p = shift;
- my $sub;
- # If it's "qr" style
- if (substr($re,0,1) eq '(') {
- $sub = sub {
+ my $sub;
+ # If it's "qr" style
+ if (substr($re,0,1) eq '(') {
+ $sub = sub {
# With methods, the value is the second argument
my $val = $force_method_p ? $_[1] : $_[0];
- my ($match) = ($val =~ $re);
- if ($untaint_this && defined $match) {
+ my ($match) = scalar ($val =~ $re);
+ if ($untaint_this && defined $match) {
# pass the value through a RE that matches anything to untaint it.
my ($untainted) = ($& =~ m/(.*)/s);
- return $untainted;
- }
- else {
- return $match;
- }
- };
-
- }
- else {
+ return $untainted;
+ }
+ else {
+ return $match;
+ }
+ };
+
+ }
+ else {
local $SIG{__DIE__} = \&confess;
my $return_code = ($untaint_this) ? '; return ($& =~ m/(.*)/s)[0] if defined($`);' : '';
# With methods, the value is the second argument
@@ -828,18 +828,18 @@ sub _create_sub_from_RE {
else {
$sub = eval 'sub { $_[0] =~ '.$re.$return_code. '}';
}
- die "Error compiling regular expression $re: $@" if $@;
- }
- return $sub;
+ die "Error compiling regular expression $re: $@" if $@;
+ }
+ return $sub;
}
sub _error_msg_fmt {
- my ($fmt,$msg) = @_;
- $fmt ||=
- '<span style="color:red;font-weight:bold"><span class="dfv_errors">* %s</span></span>';
- ($fmt =~ m/%s/) || die 'format must contain %s';
- return sprintf $fmt, $msg;
+ my ($fmt,$msg) = @_;
+ $fmt ||=
+ '<span style="color:red;font-weight:bold" class="dfv_errors">* %s</span>';
+ ($fmt =~ m/%s/) || die 'format must contain %s';
+ return sprintf $fmt, $msg;
}
@@ -855,7 +855,7 @@ sub _arrayify {
if ( ref $val eq 'ARRAY' ) {
$^W = 0; # turn off warnings about undef
return ( any(@$val) ne undef ) ? @$val : ();
- }
+ }
# if it's a string, return an array unless the string is missing or empty. -mls
else {
return (length $val) ? ($val) : ();
@@ -864,141 +864,141 @@ sub _arrayify {
# apply filter, modifying %valid by reference
# We don't bother trying to filter undefined fields.
-# This prevents warnings from Perl.
+# This prevents warnings from Perl.
sub _filter_apply {
- my ($valid,$field,$filter) = @_;
- die 'wrong number of arguments passed to _filter_apply' unless (scalar @_ == 3);
- if (ref $valid->{$field} eq 'ARRAY') {
- for (my $i = 0; $i < @{ $valid->{$field} }; $i++) {
- $valid->{$field}->[$i] = $filter->( $valid->{$field}->[$i] ) if defined $valid->{$field}->[$i];
- }
- }
- else {
- $valid->{$field} = $filter->( $valid->{$field} ) if defined $valid->{$field};
- }
+ my ($valid,$field,$filter) = @_;
+ die 'wrong number of arguments passed to _filter_apply' unless (scalar @_ == 3);
+ if (ref $valid->{$field} eq 'ARRAY') {
+ for (my $i = 0; $i < @{ $valid->{$field} }; $i++) {
+ $valid->{$field}->[$i] = $filter->( $valid->{$field}->[$i] ) if defined $valid->{$field}->[$i];
+ }
+ }
+ else {
+ $valid->{$field} = $filter->( $valid->{$field} ) if defined $valid->{$field};
+ }
}
# =head2 _constraint_hash_build()
-#
+#
# $constraint_href = $self->_constraint_hash_build($spec,$untaint_p)
#
# Input:
# - $spec # Any constraint valid in the profile
-# - $untaint # bool for whether we could try to untaint the field.
+# - $untaint # bool for whether we could try to untaint the field.
# - $force_method_p # bool for if it's a method ?
#
# Output:
# - $constraint_hashref
-# Keys are as follows:
-# constraint - the constraint as coderef
-# name - the constraint name, if we know it.
-# params - 'params', as given in the hashref style of specifying a constraint
-# is_method - bool for whether this was a 'constraint' or 'constraint_method'
+# Keys are as follows:
+# constraint - the constraint as coderef
+# name - the constraint name, if we know it.
+# params - 'params', as given in the hashref style of specifying a constraint
+# is_method - bool for whether this was a 'constraint' or 'constraint_method'
sub _constraint_hash_build {
- my ($self,$constraint_spec,$untaint_this,$force_method_p) = @_;
- die "_constraint_hash_build received wrong number of arguments" unless (scalar @_ == 4);
+ my ($self,$constraint_spec,$untaint_this,$force_method_p) = @_;
+ die "_constraint_hash_build received wrong number of arguments" unless (scalar @_ == 4);
- my $c = {
- name => $constraint_spec,
- constraint => $constraint_spec,
- };
+ my $c = {
+ name => $constraint_spec,
+ constraint => $constraint_spec,
+ };
# constraints can be passed in directly via hash
- if (ref $c->{constraint} eq 'HASH') {
- $c->{constraint} = ($constraint_spec->{constraint_method} || $constraint_spec->{constraint});
- $c->{name} = $constraint_spec->{name};
- $c->{params} = $constraint_spec->{params};
- $c->{is_method} = 1 if $constraint_spec->{constraint_method};
- }
-
- # Check for regexp constraint
- if ((ref $c->{constraint} eq 'Regexp')
- or ( $c->{constraint} =~ m@^\s*(/.+/|m(.).+\2)[cgimosx]*\s*$@ )) {
- $c->{constraint} = _create_sub_from_RE($c->{constraint},$untaint_this,$force_method_p);
- }
- # check for code ref
- elsif (ref $c->{constraint} eq 'CODE') {
- # do nothing, it's already a code ref
- }
- else {
- # provide a default name for the constraint if we don't have one already
- $c->{name} ||= $c->{constraint};
-
- #If untaint is turned on call match_* sub directly.
- if ($untaint_this) {
- my $routine = 'match_'.$c->{constraint};
- my $match_sub = *{qualify_to_ref($routine)}{CODE};
- if ($match_sub) {
- $c->{constraint} = $match_sub;
- }
- # If the constraint name starts with RE_, try looking for it in the Regexp::Common package
- elsif ($c->{constraint} =~ m/^RE_/) {
- local $SIG{__DIE__} = \&confess;
- $c->{is_method} = 1;
- $c->{constraint} = eval 'sub { &_create_regexp_common_constraint(@_)}'
- || die "could not create Regexp::Common constraint: $@";
- } else {
- die "No untainting constraint found named $c->{constraint}";
- }
- }
- else {
- # try to use match_* first
- my $routine = 'match_'.$c->{constraint};
- if (defined *{qualify_to_ref($routine)}{CODE}) {
- local $SIG{__DIE__} = \&confess;
- $c->{constraint} = eval 'sub { no strict qw/refs/; return defined &{"match_'.$c->{constraint}.'"}(@_)}';
- }
- # match_* doesn't exist; if it is supposed to be from the
- # validator_package(s) there may be only valid_* defined
- elsif (my $valid_sub = *{qualify_to_ref('valid_'.$c->{constraint})}{CODE}) {
- $c->{constraint} = $valid_sub;
- }
- # Load it from Regexp::Common
- elsif ($c->{constraint} =~ m/^RE_/) {
- local $SIG{__DIE__} = \&confess;
- $c->{is_method} = 1;
- $c->{constraint} = eval 'sub { return defined &_create_regexp_common_constraint(@_)}' ||
- die "could not create Regexp::Common constraint: $@";
- }
- else {
- die "No constraint found named '$c->{name}'";
- }
- }
- }
-
- # Save the current constraint name for later
- $self->{__CURRENT_CONSTRAINT_NAME} = $c->{name};
-
- return $c;
+ if (ref $c->{constraint} eq 'HASH') {
+ $c->{constraint} = ($constraint_spec->{constraint_method} || $constraint_spec->{constraint});
+ $c->{name} = $constraint_spec->{name};
+ $c->{params} = $constraint_spec->{params};
+ $c->{is_method} = 1 if $constraint_spec->{constraint_method};
+ }
+
+ # Check for regexp constraint
+ if ((ref $c->{constraint} eq 'Regexp')
+ or ( $c->{constraint} =~ m@^\s*(/.+/|m(.).+\2)[cgimosx]*\s*$@ )) {
+ $c->{constraint} = _create_sub_from_RE($c->{constraint},$untaint_this,$force_method_p);
+ }
+ # check for code ref
+ elsif (ref $c->{constraint} eq 'CODE') {
+ # do nothing, it's already a code ref
+ }
+ else {
+ # provide a default name for the constraint if we don't have one already
+ $c->{name} ||= $c->{constraint};
+
+ #If untaint is turned on call match_* sub directly.
+ if ($untaint_this) {
+ my $routine = 'match_'.$c->{constraint};
+ my $match_sub = *{qualify_to_ref($routine)}{CODE};
+ if ($match_sub) {
+ $c->{constraint} = $match_sub;
+ }
+ # If the constraint name starts with RE_, try looking for it in the Regexp::Common package
+ elsif ($c->{constraint} =~ m/^RE_/) {
+ local $SIG{__DIE__} = \&confess;
+ $c->{is_method} = 1;
+ $c->{constraint} = eval 'sub { &_create_regexp_common_constraint(@_)}'
+ || die "could not create Regexp::Common constraint: $@";
+ } else {
+ die "No untainting constraint found named $c->{constraint}";
+ }
+ }
+ else {
+ # try to use match_* first
+ my $routine = 'match_'.$c->{constraint};
+ if (defined *{qualify_to_ref($routine)}{CODE}) {
+ local $SIG{__DIE__} = \&confess;
+ $c->{constraint} = eval 'sub { no strict qw/refs/; return defined &{"match_'.$c->{constraint}.'"}(@_)}';
+ }
+ # match_* doesn't exist; if it is supposed to be from the
+ # validator_package(s) there may be only valid_* defined
+ elsif (my $valid_sub = *{qualify_to_ref('valid_'.$c->{constraint})}{CODE}) {
+ $c->{constraint} = $valid_sub;
+ }
+ # Load it from Regexp::Common
+ elsif ($c->{constraint} =~ m/^RE_/) {
+ local $SIG{__DIE__} = \&confess;
+ $c->{is_method} = 1;
+ $c->{constraint} = eval 'sub { return defined &_create_regexp_common_constraint(@_)}' ||
+ die "could not create Regexp::Common constraint: $@";
+ }
+ else {
+ die "No constraint found named '$c->{name}'";
+ }
+ }
+ }
+
+ # Save the current constraint name for later
+ $self->{__CURRENT_CONSTRAINT_NAME} = $c->{name};
+
+ return $c;
}
# =head2 _constraint_input_build()
-#
+#
# @params = $self->constraint_input_build($c,$value,$data);
-#
-# Build in the input that passed into the constraint.
-#
+#
+# Build in the input that passed into the constraint.
+#
# =cut
sub _constraint_input_build {
- my ($self,$c,$value,$data) = @_;
- die "_constraint_input_build received wrong number of arguments" unless (scalar @_ == 4);
-
- my @params;
- if (defined $c->{params}) {
- for my $fname (_arrayify($c->{params})) {
- # If the value is passed by reference, we treat it literally
- push @params, (ref $fname) ? $fname : $data->{$fname}
- }
- }
- else {
- push @params, $value;
- }
-
- unshift @params, $self if $c->{is_method};
- return @params;
+ my ($self,$c,$value,$data) = @_;
+ die "_constraint_input_build received wrong number of arguments" unless (scalar @_ == 4);
+
+ my @params;
+ if (defined $c->{params}) {
+ for my $fname (_arrayify($c->{params})) {
+ # If the value is passed by reference, we treat it literally
+ push @params, (ref $fname) ? $fname : $data->{$fname}
+ }
+ }
+ else {
+ push @params, $value;
+ }
+
+ unshift @params, $self if $c->{is_method};
+ return @params;
}
# =head2 _constraint_check_match()
@@ -1009,18 +1009,18 @@ sub _constraint_input_build {
#
# Input:
# - $c, a constraint hash, as returned by C<_constraint_hash_build()>.
-# - \@params, params to pass to the constraint, as prepared by C<_constraint_input_build()>.
-# - $untaint_this bool if we untaint successful constraints.
+# - \@params, params to pass to the constraint, as prepared by C<_constraint_input_build()>.
+# - $untaint_this bool if we untaint successful constraints.
#
# Output:
# - $value the value if successful
# - $failed_href a hashref with the following keys:
-# - failed bool for failure or not
-# - name name of the failed constraint, if known.
+# - failed bool for failure or not
+# - name name of the failed constraint, if known.
sub _constraint_check_match {
- my ($self,$c,$params,$untaint_this) = @_;
- die "_constraint_check_match received wrong number of arguments" unless (scalar @_ == 4);
+ my ($self,$c,$params,$untaint_this) = @_;
+ die "_constraint_check_match received wrong number of arguments" unless (scalar @_ == 4);
# Store whether or not we want untainting in the object so that constraints
# can do the right thing conditionally.
@@ -1036,48 +1036,48 @@ sub _constraint_check_match {
$success = ($untaint_this) ? length $match : $match;
}
- my $failed = 1 unless $success;
- return (
- $match,
- {
- failed => $failed,
- name => $self->{__CURRENT_CONSTRAINT_NAME},
- },
- );
+ my $failed = 1 unless $success;
+ return (
+ $match,
+ {
+ failed => $failed,
+ name => $self->{__CURRENT_CONSTRAINT_NAME},
+ },
+ );
}
# Figure out whether the data is a hash reference of a param-capable object and return it has a hash
sub _get_input_as_hash {
- my ($self,$data) = @_;
- $self->{__INPUT_DATA} = $data;
-
- require Scalar::Util;
-
- # This checks whether we have an object that supports param
- if ( Scalar::Util::blessed($data) && $data->can('param') ) {
- my %return;
- for my $k ($data->param()){
- # we expect param to return an array if there are multiple values
- my @v;
-
- # CGI::Simple requires us to call 'upload()' to get upload data,
- # while CGI/Apache::Request return it on calling 'param()'.
- #
- # This seems quirky, but there isn't a way for us to easily check if
- # "this field contains a file upload" or not.
- if ($data->isa('CGI::Simple')) {
- @v = $data->upload($k) || $data->param($k);
- }
- else {
- @v = $data->param($k);
- }
-
- # we expect param to return an array if there are multiple values
- $return{$k} = scalar(@v)>1 ? \@v : $v[0];
- }
- return %return;
- }
- # otherwise, it's already a hash reference
+ my ($self,$data) = @_;
+ $self->{__INPUT_DATA} = $data;
+
+ require Scalar::Util;
+
+ # This checks whether we have an object that supports param
+ if ( Scalar::Util::blessed($data) && $data->can('param') ) {
+ my %return;
+ for my $k ($data->param()){
+ # we expect param to return an array if there are multiple values
+ my @v;
+
+ # CGI::Simple requires us to call 'upload()' to get upload data,
+ # while CGI/Apache::Request return it on calling 'param()'.
+ #
+ # This seems quirky, but there isn't a way for us to easily check if
+ # "this field contains a file upload" or not.
+ if ($data->isa('CGI::Simple')) {
+ @v = $data->upload($k) || $data->param($k);
+ }
+ else {
+ @v = $data->param($k);
+ }
+
+ # we expect param to return an array if there are multiple values
+ $return{$k} = scalar(@v)>1 ? \@v : $v[0];
+ }
+ return %return;
+ }
+ # otherwise, it's already a hash reference
elsif (ref $data eq 'HASH') {
# be careful to actually copy array references
my %copy = %$data;
@@ -1086,41 +1086,41 @@ sub _get_input_as_hash {
$copy{$_} = \@array_copy;
}
- return %copy;
+ return %copy;
+ }
+ else {
+ die "Data::FormValidator->validate() or check() called with invalid input data structure.";
}
- else {
- die "Data::FormValidator->validate() or check() called with invalid input data structure.";
- }
}
# A newer version of this logic now exists in Constraints.pm in the AUTOLOADing section
# This is is used to support the older param passing style. Eg:
#
# {
-# constraint => 'RE_foo_bar',
-# params => [ \'zoo' ]
+# constraint => 'RE_foo_bar',
+# params => [ \'zoo' ]
# }
#
# Still, it's possible, the two bits of logic could be refactored into one location if you cared
-# to do that.
+# to do that.
sub _create_regexp_common_constraint {
- # this should work most of the time and is useful for preventing warnings
-
- # prevent name space clashes
- package Data::FormValidator::Constraints::RegexpCommon;
-
- require Regexp::Common;
- import Regexp::Common 'RE_ALL';
-
- my $self = shift;
- my $re_name = $self->get_current_constraint_name;
- # deference all input
- my @params = map {$_ = $$_ if ref $_ } @_;
-
- no strict "refs";
- my $re = &$re_name(-keep=>1,@params) || die 'no matching Regexp::Common routine found';
- return ($self->get_current_constraint_value =~ qr/^$re$/) ? $1 : undef;
+ # this should work most of the time and is useful for preventing warnings
+
+ # prevent name space clashes
+ package Data::FormValidator::Constraints::RegexpCommon;
+
+ require Regexp::Common;
+ import Regexp::Common 'RE_ALL';
+
+ my $self = shift;
+ my $re_name = $self->get_current_constraint_name;
+ # deference all input
+ my @params = map {$_ = $$_ if ref $_ } @_;
+
+ no strict "refs";
+ my $re = &$re_name(-keep=>1,@params) || die 'no matching Regexp::Common routine found';
+ return ($self->get_current_constraint_value =~ qr/^$re$/) ? $1 : undef;
}
# _add_constraints_from_map($profile,'constraint',\%valid);
@@ -1128,39 +1128,39 @@ sub _create_regexp_common_constraint {
# - a hash to add to either 'constraints' or 'constraint_methods'
sub _add_constraints_from_map {
- die "_add_constraints_from_map: need 3 arguments" unless (scalar @_ == 3);
- my ($profile, $name, $valid) = @_;
- ($name =~ m/^constraint(_method)?$/) || die "unexpected input.";
-
- my $key_name = $name.'s';
- my $map_name = $name.'_regexp_map';
-
- my %result = ();
- for my $re (keys %{ $profile->{$map_name} }) {
- my $sub = _create_sub_from_RE($re);
-
- # find all the keys that match this RE and add a constraint for them
- for my $key (keys %$valid) {
- if ($sub->($key)) {
- my $cur = $profile->{$key_name}{$key};
- my $new = $profile->{$map_name}{$re};
- # If they already have an arrayref of constraints, add to the list
- if (ref $cur eq 'ARRAY') {
+ die "_add_constraints_from_map: need 3 arguments" unless (scalar @_ == 3);
+ my ($profile, $name, $valid) = @_;
+ ($name =~ m/^constraint(_method)?$/) || die "unexpected input.";
+
+ my $key_name = $name.'s';
+ my $map_name = $name.'_regexp_map';
+
+ my %result = ();
+ for my $re (keys %{ $profile->{$map_name} }) {
+ my $sub = _create_sub_from_RE($re);
+
+ # find all the keys that match this RE and add a constraint for them
+ for my $key (keys %$valid) {
+ if ($sub->($key)) {
+ my $cur = $profile->{$key_name}{$key};
+ my $new = $profile->{$map_name}{$re};
+ # If they already have an arrayref of constraints, add to the list
+ if (ref $cur eq 'ARRAY') {
push @{ $result{$key} }, @$cur, $new;
- }
- # If they have a single constraint defined, create an array ref with with this plus the new one
- elsif ($cur) {
- $result{$key} = [$cur,$new];
- }
- # otherwise, a new constraint is created with this as the single constraint
- else {
- $result{$key} = $new;
- }
- warn "$map_name: $key matches\n" if $profile->{debug};
- }
- }
- }
- return %result;
+ }
+ # If they have a single constraint defined, create an array ref with with this plus the new one
+ elsif ($cur) {
+ $result{$key} = [$cur,$new];
+ }
+ # otherwise, a new constraint is created with this as the single constraint
+ else {
+ $result{$key} = $new;
+ }
+ warn "$map_name: $key matches\n" if $profile->{debug};
+ }
+ }
+ }
+ return %result;
}
sub _bool_overload_based_on_success {
@@ -1171,11 +1171,11 @@ sub _bool_overload_based_on_success {
# =head2 _check_constraints()
#
# $self->_check_constraints(
-# $profile->{constraint_methods},
-# \%valid,
-# $untaint_all
-# \%untaint_hash
-# $force_method_p
+# $profile->{constraint_methods},
+# \%valid,
+# $untaint_all
+# \%untaint_hash
+# $force_method_p
#);
#
# Input:
@@ -1183,41 +1183,41 @@ sub _bool_overload_based_on_success {
# - hashref of valid data
# - bool to try to untaint everything
# - hashref of things to untaint
-# - bool if all constraints should be treated as methods.
-
+# - bool if all constraints should be treated as methods.
+
sub _check_constraints {
- my ($self,
- $constraint_href,
- $valid,
- $untaint_all,
- $untaint_href,
- $force_method_p) = @_;
+ my ($self,
+ $constraint_href,
+ $valid,
+ $untaint_all,
+ $untaint_href,
+ $force_method_p) = @_;
- while ( my ($field,$constraint_list) = each %$constraint_href ) {
- next unless exists $valid->{$field};
+ while ( my ($field,$constraint_list) = each %$constraint_href ) {
+ next unless exists $valid->{$field};
- my $is_constraint_list = 1 if (ref $constraint_list eq 'ARRAY');
- my $untaint_this = ($untaint_all || $untaint_href->{$field} || 0);
+ my $is_constraint_list = 1 if (ref $constraint_list eq 'ARRAY');
+ my $untaint_this = ($untaint_all || $untaint_href->{$field} || 0);
- my @invalid_list;
+ my @invalid_list;
# used to insure we only bother recording each failed constraint once
- my %constraints_seen;
- for my $constraint_spec (_arrayify($constraint_list)) {
+ my %constraints_seen;
+ for my $constraint_spec (_arrayify($constraint_list)) {
- # set current constraint field for use by get_current_constraint_field
- $self->{__CURRENT_CONSTRAINT_FIELD} = $field;
+ # set current constraint field for use by get_current_constraint_field
+ $self->{__CURRENT_CONSTRAINT_FIELD} = $field;
- # Initialize the current constraint name to undef, to prevent it
- # from being accidently shared
- $self->{__CURRENT_CONSTRAINT_NAME} = undef;
+ # Initialize the current constraint name to undef, to prevent it
+ # from being accidently shared
+ $self->{__CURRENT_CONSTRAINT_NAME} = undef;
- my $c = $self->_constraint_hash_build($constraint_spec,$untaint_this, $force_method_p);
- $c->{is_method} = 1 if $force_method_p;
+ my $c = $self->_constraint_hash_build($constraint_spec,$untaint_this, $force_method_p);
+ $c->{is_method} = 1 if $force_method_p;
- my $is_value_list = 1 if (ref $valid->{$field} eq 'ARRAY');
+ my $is_value_list = 1 if (ref $valid->{$field} eq 'ARRAY');
my %param_data = ( $self->_get_input_as_hash($self->get_input_data) , %$valid );
- if ($is_value_list) {
- for (my $i = 0; $i < scalar @{ $valid->{$field}} ; $i++) {
+ if ($is_value_list) {
+ for (my $i = 0; $i < scalar @{ $valid->{$field}} ; $i++) {
if( !exists $constraints_seen{\$c} ) {
my @params = $self->_constraint_input_build($c,$valid->{$field}->[$i],\%param_data);
@@ -1234,31 +1234,31 @@ sub _check_constraints {
$valid->{$field}->[$i] = $match if $untaint_this;
}
}
- }
- }
- else {
- my @params = $self->_constraint_input_build($c,$valid->{$field},\%param_data);
-
- # set current constraint field for use by get_current_constraint_value
- $self->{__CURRENT_CONSTRAINT_VALUE} = $valid->{$field};
-
- my ($match,$failed) = $self->_constraint_check_match($c,\@params,$untaint_this);
- if ($failed->{failed}) {
- push @invalid_list, $failed
- }
- else {
- $valid->{$field} = $match if $untaint_this;
- }
- }
- }
-
- if (@invalid_list) {
- my @failed = map { $_->{name} } @invalid_list;
- push @{ $self->{invalid}{$field} }, @failed;
+ }
+ }
+ else {
+ my @params = $self->_constraint_input_build($c,$valid->{$field},\%param_data);
+
+ # set current constraint field for use by get_current_constraint_value
+ $self->{__CURRENT_CONSTRAINT_VALUE} = $valid->{$field};
+
+ my ($match,$failed) = $self->_constraint_check_match($c,\@params,$untaint_this);
+ if ($failed->{failed}) {
+ push @invalid_list, $failed
+ }
+ else {
+ $valid->{$field} = $match if $untaint_this;
+ }
+ }
+ }
+
+ if (@invalid_list) {
+ my @failed = map { $_->{name} } @invalid_list;
+ push @{ $self->{invalid}{$field} }, @failed;
# the older interface to validate returned things differently
- push @{ $self->{validate_invalid} }, $is_constraint_list ? [$field, @failed] : $field;
- }
- }
+ push @{ $self->{validate_invalid} }, $is_constraint_list ? [$field, @failed] : $field;
+ }
+ }
}
1;
@@ -1275,7 +1275,7 @@ Data::FormValidator::Constraints, Data::FormValidator::ConstraintsFactory
=head1 AUTHOR
Author: Francis J. Lacoste <francis.lacoste@iNsu.COM>
-Maintainer: Mark Stosberg <mark@summersault.com>
+Maintainer: Mark Stosberg <mark@summersault.com>
=head1 COPYRIGHT
@@ -3,19 +3,19 @@
#
# This file is part of Data::FormValidator.
#
-# Author: Francis J. Lacoste
+# Author: Francis J. Lacoste
# Maintainer: Mark Stosberg <mark@stosberg.com>
#
# Copyright (C) 1999 Francis J. Lacoste, iNsu Innovations
-# Parts Copyright 1996-1999 by Michael J. Heins
-# Parts Copyright 1996-1999 by Bruce Albrecht
-# Parts Copyright 2001-2005 by Mark Stosberg
+# Parts Copyright 1996-1999 by Michael J. Heins
+# Parts Copyright 1996-1999 by Bruce Albrecht
+# Parts Copyright 2001-2005 by Mark Stosberg
#
# Parts of this module are based on work by
# Bruce Albrecht, contributed to
# MiniVend.
#
-# Parts also based on work by Michael J. Heins
+# Parts also based on work by Michael J. Heins
#
# This program is free software; you can redistribute it and/or modify
# it under the terms same terms as perl itself.
@@ -23,7 +23,7 @@
package Data::FormValidator;
-use 5.005; # for "qr" support, which isn't strictly required.
+use 5.005; # for "qr" support, which isn't strictly required.
use Perl6::Junction qw(any none);
use Data::FormValidator::Results;
@@ -33,7 +33,7 @@ use Data::FormValidator::Constraints qw(:validators :matchers);
use vars qw( $VERSION $AUTOLOAD @ISA @EXPORT_OK %EXPORT_TAGS );
-$VERSION = '4.63';
+$VERSION = '4.65';
require Exporter;
@ISA = qw(Exporter);
@@ -87,7 +87,7 @@ require Exporter;
match_state_or_province
match_zip
match_zip_or_postcode
- /],
+ /],
);
@EXPORT_OK = (@{ $EXPORT_TAGS{filters} }, @{ $EXPORT_TAGS{validators} }, @{ $EXPORT_TAGS{matchers} });
@@ -108,9 +108,9 @@ on input profile.
=head1 SYNOPSIS
use Data::FormValidator;
-
+
my $results = Data::FormValidator->check(\%input_hash, \%dfv_profile);
-
+
if ($results->has_invalid or $results->has_missing) {
# do something with $results->invalid, $results->missing
# or $results->msgs
@@ -128,7 +128,7 @@ simple format.
Data::FormValidator lets you define profiles which declare the
required and optional fields and any constraints they might have.
-The results are provided as an object which makes it easy to handle
+The results are provided as an object which makes it easy to handle
missing and invalid results, return error messages about which constraints
failed, or process the resulting valid data.
@@ -142,7 +142,7 @@ sub new {
my $class = ref $proto || $proto;
if ($defaults) {
- ref $defaults eq 'HASH' or
+ ref $defaults eq 'HASH' or
die 'second argument to new must be a hash ref';
}
@@ -156,7 +156,7 @@ sub new {
}
- bless {
+ bless {
profile_file => $file,
profiles => $profiles,
defaults => $defaults,
@@ -177,7 +177,7 @@ array described below.
use Data::FormValidator;
my $results = Data::FormValidator->check(\%input_hash, \%dfv_profile);
-Here, C<check()> is used as a class method, and takes two required parameters.
+Here, C<check()> is used as a class method, and takes two required parameters.
The first a reference to the data to be be validated. This can either be a hash
reference, or a CGI.pm-like object. In particular, the object must have a param()
@@ -189,7 +189,7 @@ The second argument is a reference to the profile you are validating.
=head2 validate()
- my( $valids, $missings, $invalids, $unknowns ) =
+ my( $valids, $missings, $invalids, $unknowns ) =
Data::FormValidator->validate( \%input_hash, \%dfv_profile);
C<validate()> provides a deprecated alternative to C<check()>. It has the same input
@@ -213,12 +213,12 @@ I<dependencies> list.
This is a reference to an array which contains the name of the fields which
failed one or more of their constraint checks. If there are no invalid fields,
-an empty arrayref will be returned.
+an empty arrayref will be returned.
Fields defined with multiple constraints will have an array ref returned in the
@invalids array instead of a string. The first element in this array is the
name of the field, and the remaining fields are the names of the failed
-constraints.
+constraints.
=item unknowns
@@ -262,16 +262,16 @@ Now when calling C<check()>, you just need to supply the profile name:
=item o
-Applying defaults to more than one input profile. There are some parts
+Applying defaults to more than one input profile. There are some parts
of the validation profile that you might like to re-use for many form
-validations.
+validations.
To facilitate this, C<new()> takes a second argument, a hash reference. Here
the usual input profile definitions can be made. These will act as defaults for
any subsequent calls to C<check()> on this object.
Currently the logic for this is very simple. Any definition of a key in your
-validation profile will completely overwrite your default value.
+validation profile will completely overwrite your default value.
This means you can't define two keys for C<constraint_regexp_map> and expect
they will always be there. This kind of feature may be added in the future.
@@ -281,9 +281,9 @@ able to define some defaults for the top level keys within C<msgs> and not have
them clobbered just because C<msgs> was defined in a validation profile.
One way to use this feature is to create your own sub-class that always provides
-your defaults to C<new()>.
+your defaults to C<new()>.
-Another option is to create your own wrapper routine which provides these defaults to
+Another option is to create your own wrapper routine which provides these defaults to
C<new()>. Here's an example of a routine you might put in a
L<CGI::Application|CGI::Application> super-class to make use of this feature:
@@ -291,11 +291,11 @@ L<CGI::Application|CGI::Application> super-class to make use of this feature:
# and provide some defaults to new constructor
sub check_form {
my $self = shift;
- my $profile = shift
+ my $profile = shift
|| die 'check_form: missing required profile';
-
+
require Data::FormValidator;
- my $dfv = Data::FormValidator->new({},{
+ my $dfv = Data::FormValidator->new({},{
# your defaults here
});
return $dfv->check($self->query,$profile);
@@ -321,7 +321,7 @@ sub validate {
sub check {
my ( $self, $data, $name ) = @_;
-
+
# check can be used as a class method for simple cases
if (not ref $self) {
my $class = $self;
@@ -343,8 +343,8 @@ sub check {
if ($self->{defaults}) {
$profile = { %{$self->{defaults}}, %$profile };
}
-
- # check the profile syntax or die with an error.
+
+ # check the profile syntax or die with an error.
_check_profile_syntax($profile);
my $results = Data::FormValidator::Results->new( $profile, $data );
@@ -358,7 +358,7 @@ sub check {
=head1 INPUT PROFILE SPECIFICATION
An input profile is a hash reference containing one or more of the following
-keys.
+keys.
Here is a very simple input profile. Examples of more advanced options are
described below.
@@ -367,16 +367,16 @@ described below.
my $profile = {
optional => [qw( company
- fax
+ fax
country )],
- required => [qw( fullname
- phone
- email
+ required => [qw( fullname
+ phone
+ email
address )],
constraint_methods => {
- email => email(),
+ email => email(),
}
};
@@ -404,7 +404,7 @@ will be required.
require_some => {
# require any two fields from this group
- city_or_state_or_zipcode => [ 2, qw/city state zipcode/ ],
+ city_or_state_or_zipcode => [ 2, qw/city state zipcode/ ],
}
This is a reference to a hash which defines groups of fields where 1 or more
@@ -413,7 +413,7 @@ matter. The keys in the hash are the group names. These are returned as
"missing" unless the required number of fields from the group has been filled
in. The values in this hash are array references. The first element in this
array should be the number of fields in the group that is required. If the
-first field in the array is not an a digit, a default of "1" will be used.
+first field in the array is not an a digit, a default of "1" will be used.
=head2 optional
@@ -429,7 +429,7 @@ will be reported as unknown.
optional_regexp => qr/_province$/,
This is a regular expression used to specify additional fields which are
-optional. For example, if you wanted all fields names that begin with I<user_>
+optional. For example, if you wanted all fields names that begin with I<user_>
to be optional, you could use the regular expression, /^user_/
=head2 dependencies
@@ -448,14 +448,14 @@ to be optional, you could use the regular expression, /^user_/
"cc_type" => sub {
my $dfv = shift;
my $type = shift;
-
+
return [ 'cc_cvv' ] if ($type eq "VISA" || $type eq "MASTERCARD");
return [ ];
},
},
This is for the case where an optional field has other requirements. The
-dependent fields can be specified with an array reference.
+dependent fields can be specified with an array reference.
If the dependencies are specified with a hash reference then the additional
constraint is added that the optional field must equal a key for the
@@ -476,9 +476,9 @@ will be reported as missing.
password_group => [qw/password password_confirmation/],
}
-This is a hash reference which contains information about groups of
+This is a hash reference which contains information about groups of
interdependent fields. The keys are arbitrary names that you create and
-the values are references to arrays of the field names in each group.
+the values are references to arrays of the field names in each group.
=head2 defaults
@@ -486,12 +486,12 @@ the values are references to arrays of the field names in each group.
country => "USA",
},
-This is a hash reference where keys are field names and
-values are defaults to use if input for the field is missing.
+This is a hash reference where keys are field names and
+values are defaults to use if input for the field is missing.
-The values can be code refs which will be used to calculate the
+The values can be code refs which will be used to calculate the
value if needed. These code refs will be passed in the DFV::Results
-object as the only parameter.
+object as the only parameter.
The defaults are set shortly before the constraints are applied, and
will be returned with the other valid data.
@@ -503,7 +503,7 @@ will be returned with the other valid data.
},
This is a hash reference that maps regular expressions to default values to
-use for matching optional or required fields.
+use for matching optional or required fields.
It's useful if you have generated many checkbox fields with the similar names.
Since checkbox fields submit nothing at all when they are not checked, it's
@@ -511,8 +511,8 @@ useful to set defaults for them.
Note that it doesn't make sense to use a default for a field handled by
C<optional_regexp> or C<required_regexp>. When the field is not submitted,
-there is no way know that it should be optional or required, and thus there's
-no way to know that a default should be set for it.
+there is no way to know that it should be optional or required, and thus there's
+no way to know that a default should be set for it.
=head2 filters
@@ -520,19 +520,19 @@ no way to know that a default should be set for it.
filters => ['trim'],
This is a reference to an array of filters that will be applied to ALL optional
-and required fields, B<before> any constraints are applied.
+and required fields, B<before> any constraints are applied.
This can be the name of a built-in filter
-(trim,digit,etc) or an anonymous subroutine which should take one parameter,
+(trim,digit,etc) or an anonymous subroutine which should take one parameter,
the field value and return the (possibly) modified value.
-Filters modify the data returned through the results object, so use them carefully.
+Filters modify the data returned through the results object, so use them carefully.
See L<Data::FormValidator::Filters> for details on the built-in filters.
=head2 field_filters
- field_filters => {
+ field_filters => {
cc_no => ['digit'],
},
@@ -540,7 +540,7 @@ A hash ref with field names as keys. Values are array references of built-in
filters to apply (trim,digit,etc) or an anonymous subroutine which should take
one parameter, the field value and return the (possibly) modified value.
-Filters are applied B<before> any constraints are applied.
+Filters are applied B<before> any constraints are applied.
See L<Data::FormValidator::Filters> for details on the built-in filters.
@@ -571,18 +571,18 @@ A hash ref which contains the constraints that will be used to check whether or
not the field contains valid data.
B<Note:> To use the built-in constraints, they need to first be loaded into your
-name space using the syntax above. (Unless you are using the old C<constraints> key,
-documented in L<BACKWARDS COMPATIBILITY>).
+name space using the syntax above. (Unless you are using the old C<constraints> key,
+documented in L<BACKWARDS COMPATIBILITY>).
The keys in this hash are field names. The values can be any of the following:
-=over
+=over
=item o
-A named constraint.
+A named constraint.
-B<Example>:
+B<Example>:
my_zipcode_field => zip(),
@@ -590,11 +590,11 @@ See L<Data::FormValidator::Constraints> for the details of which
built-in constraints that are available.
-=item o
+=item o
A perl regular expression
-B<Example>:
+B<Example>:
my_zipcode_field => qr/^\d{5}$/, # match exactly 5 digits
@@ -611,27 +611,27 @@ a subroutine reference, to supply custom code
This will check the input and return true or false depending on the input's validity.
By default, the constraint function receives a L<Data::FormValidator::Results>
object as its first argument, and the value to be validated as the second. To
-validate a field based more inputs than just the field itself, see
+validate a field based on more inputs than just the field itself, see
L<VALIDATING INPUT BASED ON MULTIPLE FIELDS>.
B<Examples>:
- # Notice the use of 'pop'--
+ # Notice the use of 'pop'--
# the object is the first arg passed to the method
# while the value is the second, and last arg.
- my_zipcode_field => sub { my $val = pop; return $val =~ '/^\d{5}$/' },
-
+ my_zipcode_field => sub { my $val = pop; return $val =~ '/^\d{5}$/' },
+
# OR you can reference a subroutine, which should work like the one above
- my_zipcode_field => \&my_validation_routine,
+ my_zipcode_field => \&my_validation_routine,
# An example of setting the constraint name.
- my_zipcode_field => sub {
- my ($dfv, $val) = @_;
- $dfv->set_current_constraint_name('my_constraint_name');
- return $val =~ '/^\d{5}$/'
- },
+ my_zipcode_field => sub {
+ my ($dfv, $val) = @_;
+ $dfv->set_current_constraint_name('my_constraint_name');
+ return $val =~ '/^\d{5}$/'
+ },
-=item o
+=item o
an array reference
@@ -647,14 +647,14 @@ For more details see L<VALIDATING INPUT BASED ON MULTIPLE FIELDS>.
use Data::FormValidator::Constraints qw(:closures);
- # In your profile.
+ # In your profile.
constraint_method_regexp_map => {
# All fields that end in _postcode have the 'postcode' constraint applied.
qr/_postcode$/ => postcode(),
- },
+ },
A hash ref where the keys are the regular expressions to
-use and the values are the constraints to apply.
+use and the values are the constraints to apply.
If one or more constraints have already been defined for a given field using
C<constraint_methods>, C<constraint_method_regexp_map> will add an additional
@@ -669,8 +669,7 @@ The untainted data will be returned in the valid hash. Untainting is based on
the pattern match used by the constraint. Note that some constraint routines
may not provide untainting.
-See L<Writing your own constraint routines|Data::FormValidator::Constraints/"WRITING YOUR OWN CONSTRAINT ROUTINES"> in the Data::FormValidator::Constraints
-documentation for more information.
+See L<Writing your own constraint routines|Data::FormValidator::Constraints/"WRITING YOUR OWN CONSTRAINT ROUTINES"> for more information.
This is overridden by C<untaint_constraint_fields> and C<untaint_regexp_map>.
@@ -680,7 +679,7 @@ This is overridden by C<untaint_constraint_fields> and C<untaint_regexp_map>.
Specifies that one or more fields will be untainted if they pass their
constraint(s). This can be set to a single field name or an array reference of
-field names. The untainted data will be returned in the valid hash.
+field names. The untainted data will be returned in the valid hash.
This overrides the untaint_all_constraints flag.
@@ -694,7 +693,7 @@ regex, or an array reference of regexes. The untainted data will be returned
in the valid hash.
The above example would untaint the fields named C<some_field_1>, and C<some_field_2>
-but not C<some_field>.
+but not C<some_field>.
This overrides the untaint_all_constraints flag.
@@ -704,13 +703,13 @@ This overrides the untaint_all_constraints flag.
This can be set to a true value to cause optional fields with empty values to
be included in the valid hash. By default they are not included-- this is the
-historical behavior.
+historical behavior.
This is an important flag if you are using the contents of an "update" form to
update a record in a database. Without using the option, fields that have been
set back to "blank" may fail to get updated.
-=head2 validator_packages
+=head2 validator_packages
# load all the constraints and filters from these modules
validator_packages => [qw(Data::FormValidator::Constraints::Upload)],
@@ -722,7 +721,7 @@ of its constraint and filter routines beginning with 'match_', 'valid_' and
them in a constraint with just their name, just like built-in routines. You
can even override the provided validators.
-See L<WRITING YOUR OWN CONSTRAINT ROUTINES> in the Data::FormValidator::Constraints
+See L<Writing your own constraint routines|Data::FormValidator::Constraints/"WRITING YOUR OWN CONSTRAINT ROUTINES">
documentation for more information
=head2 msgs
@@ -731,15 +730,15 @@ This key is used to define parameters related to formatting error messages
returned to the user.
By default, invalid fields have the message "Invalid" associated with them
-while missing fields have the message "Missing" associated with them.
+while missing fields have the message "Missing" associated with them.
In the simplest case, nothing needs to be defined here, and the default values
-will be used.
+will be used.
The default formatting applied is designed for display in an XHTML web page.
That formatting is as followings:
- <span style="color:red;font-weight:bold"><span class="dfv_errors">* %s</span></span>
+ <span style="color:red;font-weight:bold" class="dfv_errors">* %s</span>
The C<%s> will be replaced with the message. The effect is that the message
will appear in bold red with an asterisk before it. This style can be overridden by simply
@@ -749,31 +748,31 @@ Here's a more complex example that shows how to provide your own default message
as providing custom messages per field, and handling multiple constraints:
msgs => {
-
+
# set a custom error prefix, defaults to none
prefix=> 'error_',
-
+
# Set your own "Missing" message, defaults to "Missing"
missing => 'Not Here!',
-
+
# Default invalid message, default's to "Invalid"
invalid => 'Problematic!',
-
+
# message separator for multiple messages
# Defaults to ' '
invalid_separator => ' <br /> ',
-
+
# formatting string, default given above.
format => 'ERROR: %s',
-
+
# Error messages, keyed by constraint name
# Your constraints must be named to use this.
constraints => {
'date_and_time' => 'Not a valid time format',
# ...
},
-
- # This token will be included in the hash if there are
+
+ # This token will be included in the hash if there are
# any errors returned. This can be useful with templating
# systems like HTML::Template
# The 'prefix' setting does not apply here.
@@ -784,10 +783,10 @@ as providing custom messages per field, and handling multiple constraints:
The hash that's prepared can be retrieved through the C<msgs> method
described in the L<Data::FormValidator::Results> documentation.
-=head2 msgs - callback
+=head2 msgs - callback
I<This is a new feature. While it expected to be forward-compatible, it hasn't
-yet received the testing the rest of the API has.>
+yet received the testing the rest of the API has.>
If the built-in message generation doesn't suit you, it is also possible to
provide your own by specifying a code reference:
@@ -796,18 +795,18 @@ provide your own by specifying a code reference:
This will be called as a L<Data::FormValidator::Results> method. It may
receive as arguments an additional hash reference of control parameters,
-corresponding to the key names in the usually used in the C<msgs> area of the
-profile. You can ignore this information if you'd like.
+corresponding to the key names usually used in the C<msgs> area of the
+profile. You can ignore this information if you'd like.
If you have an alternative error message handler you'd like to share, stick in
-the C<Data::FormValidator::ErrMsgs> name space and upload it to CPAN.
+the C<Data::FormValidator::ErrMsgs> name space and upload it to CPAN.
=head2 debug
This method is used to print details about what is going on to STDERR.
-Currently only level '1' is used. It provides information about which
-fields matched constraint_regexp_map.
+Currently only level '1' is used. It provides information about which
+fields matched constraint_regexp_map.
=head2 A shortcut for array refs
@@ -838,10 +837,10 @@ Deprecated, but supported
You can pass more than one value into a constraint routine. For that, the
value of the constraint should be a hash reference. If you are creating your
-own routines, be sure to read the section labeled
-L<WRITING YOUR OWN CONSTRAINT ROUTINES>,
+own routines, be sure to read the section labeled
+L<WRITING YOUR OWN CONSTRAINT ROUTINES>,
in the Data::FormValidator::Constraints documentation. It describes
-a newer and more flexible syntax.
+a newer and more flexible syntax.
Using the original syntax, one key should be named C<constraint> and should
have a value set to the reference of the subroutine or the name of a built-in
@@ -855,7 +854,7 @@ check in that list, if you are using this syntax.
B<Example>:
- cc_no => {
+ cc_no => {
constraint => "cc_number",
params => [ qw( cc_no cc_type ) ],
},
@@ -875,14 +874,14 @@ constraint. Here's an example:
my_zipcode_field => [
'zip',
- {
- constraint => '/^406/',
+ {
+ constraint => '/^406/',
name => 'starts_with_406',
}
],
You can use an array reference with a single constraint in it if you just want
-to have the name of your failed constraint returned in the above fashion.
+to have the name of your failed constraint returned in the above fashion.
Read about the C<validate()> function above to see how multiple constraints
are returned differently with that method.
@@ -920,35 +919,35 @@ sub _check_profile_syntax {
my @invalid;
# check top level keys
- {
+ {
my @valid_profile_keys = (qw/
- constraint_methods
- constraint_method_regexp_map
- constraint_regexp_map
- constraints
- defaults
- defaults_regexp_map
- dependencies
- dependency_groups
- field_filter_regexp_map
- field_filters
- filters
- missing_optional_valid
- msgs
- optional
- optional_regexp
- require_some
- required
- required_regexp
- untaint_all_constraints
- validator_packages
- untaint_constraint_fields
- untaint_regexp_map
- debug
+ constraint_methods
+ constraint_method_regexp_map
+ constraint_regexp_map
+ constraints
+ defaults
+ defaults_regexp_map
+ dependencies
+ dependency_groups
+ field_filter_regexp_map
+ field_filters
+ filters
+ missing_optional_valid
+ msgs
+ optional
+ optional_regexp
+ require_some
+ required
+ required_regexp
+ untaint_all_constraints
+ validator_packages
+ untaint_constraint_fields
+ untaint_regexp_map
+ debug
/);
- # If any of the keys in the profile are not listed as
- # valid keys here, we die with an error
+ # If any of the keys in the profile are not listed as
+ # valid keys here, we die with an error
for my $key (keys %$profile) {
push @invalid, $key unless ($key eq any(@valid_profile_keys));
}
@@ -963,7 +962,7 @@ sub _check_profile_syntax {
{
# Cases:
# 1. constraint_methods => { field => func() }
- # 2. constraint_methods => { field => [ func() ] }
+ # 2. constraint_methods => { field => [ func() ] }
# 3. constraint_method_regex_map => { qr/^field/ => func() }
# 4. constraint_method_regex_map => { qr/^field/ => [ func() ] }
# 5. constraint_methods => { field => { constraint_method => func() } }
@@ -974,13 +973,13 @@ sub _check_profile_syntax {
if ((ref $val eq 'HASH') and ref $val->{constraint_method} eq none('CODE','Regexp')) {
die "Value for constraint_method within hashref '$val->{constraint_method}' not a code reference or Regexp . Do you need func(), not 'func'?";
}
- # Cases 1 through 4.
+ # Cases 1 through 4.
elsif (ref $val eq none('HASH','CODE','Regexp')) {
die "Value for constraint_method '$val' not a code reference or Regexp . Do you need func(), not 'func'?";
}
# Case 5.
else {
- # We're cool. Nothing to do.
+ # We're cool. Nothing to do.
}
}
}
@@ -989,15 +988,15 @@ sub _check_profile_syntax {
# Check constraint hash keys
{
my @valid_constraint_hash_keys = (qw/
- constraint
- constraint_method
- name
- params
+ constraint
+ constraint_method
+ name
+ params
/);
- my @constraint_hashrefs = grep { ref $_ eq 'HASH' } values %{ $profile->{constraints} }
+ my @constraint_hashrefs = grep { ref $_ eq 'HASH' } values %{ $profile->{constraints} }
if $profile->{constraints};
- push @constraint_hashrefs, grep { ref $_ eq 'HASH' } values %{ $profile->{constraint_regexp_map} }
+ push @constraint_hashrefs, grep { ref $_ eq 'HASH' } values %{ $profile->{constraint_regexp_map} }
if $profile->{constraint_regexp_map};
for my $href (@constraint_hashrefs) {
@@ -1014,14 +1013,14 @@ sub _check_profile_syntax {
# Check msgs keys
{
my @valid_msgs_hash_keys = (qw/
- prefix
- missing
- invalid
- invalid_separator
- invalid_seperator
- format
- constraints
- any_errors
+ prefix
+ missing
+ invalid
+ invalid_separator
+ invalid_seperator
+ format
+ constraints
+ any_errors
/);
if (ref $profile->{msgs} eq 'HASH') {
for my $key (keys %{ $profile->{msgs} }) {
@@ -1054,7 +1053,7 @@ profile could also be built on the fly with custom Perl code.
=head2 validate()
- my( $valids, $missings, $invalids, $unknowns ) =
+ my( $valids, $missings, $invalids, $unknowns ) =
Data::FormValidator->validate( \%input_hash, \%dfv_profile);
C<validate()> provides a deprecated alternative to C<check()>. It has the same input
@@ -1082,7 +1081,7 @@ which failed one or more of their constraint checks.
Fields defined with multiple constraints will have an array ref returned in the
@invalids array instead of a string. The first element in this array is the
name of the field, and the remaining fields are the names of the failed
-constraints.
+constraints.
=item unknowns
@@ -1095,10 +1094,10 @@ dependant.
=head2 constraints (profile key)
This is a supported but deprecated profile key. Using C<constraint_methods> is
-recommended instead, which provides a simpler, more versatile interface.
+recommended instead, which provides a simpler, more versatile interface.
constraints => {
- cc_no => {
+ cc_no => {
constraint => "cc_number",
params => [ qw( cc_no cc_type ) ],
},
@@ -1111,13 +1110,13 @@ will be used to check whether or not the field contains valid data.
The keys in this hash are field names. The values can be any of the following:
-=over
+=over
=item o
-A named constraint.
+A named constraint.
-B<Example>:
+B<Example>:
my_zipcode_field => 'zip',
@@ -1126,7 +1125,7 @@ built-in constraints that are available.
=back
-=head2 hashref style of specifying constraints
+=head2 hashref style of specifying constraints
Using a hash reference to specify a constraint is an older technique
used to name a constraint or supply multiple parameters.
@@ -1135,7 +1134,7 @@ Both of these interface issues are now better addressed with C<constraint_method
and C<$self-\>name_this('foo')>.
# supply multiple parameters
- cc_no => {
+ cc_no => {
constraint => "cc_number",
params => [ qw( cc_no cc_type ) ],
},
@@ -1151,21 +1150,21 @@ arguments. Required arguments are C<constraint> or C<constraint_method>.
Optional arguments are C<name> and C<params>.
A C<name> on a constraints 'glues' the constraint to its error message
-in the validator profile (refer C<msgs> section below). If no C<name> is
-given then it will default to the value of C<constraint> or
+in the validator profile (refer C<msgs> section below). If no C<name> is
+given then it will default to the value of C<constraint> or
C<constraint_method> IF they are NOT a CODE ref or a RegExp ref.
-The C<params> value is a reference to an array of the parameters to pass
-to the constraint method.
+The C<params> value is a reference to an array of the parameters to pass
+to the constraint method.
If an element of the C<params> list is a scalar, it is assumed to be naming
-a key of the %input_hash and that value is passed to the routine.
-If the parameter is a reference, then it is treated literally and passed
+a key of the %input_hash and that value is passed to the routine.
+If the parameter is a reference, then it is treated literally and passed
unchanged to the routine.
-If you are using the older C<constraint> over
-the new C<constraint_method> then don't forget to include the name of the
+If you are using the older C<constraint> over
+the new C<constraint_method> then don't forget to include the name of the
field to check in the C<params> list. C<constraint_method> provides access
-to this value via the C<get_current_*> methods
+to this value via the C<get_current_*> methods
(refer L<Data::FormValidator::Constraints>)
For more details see L<VALIDATING INPUT BASED ON MULTIPLE FIELDS>.
@@ -1178,10 +1177,10 @@ C<constraint_methods_regexp_map> is recommended instead.
constraint_regexp_map => {
# All fields that end in _postcode have the 'postcode' constraint applied.
qr/_postcode$/ => 'postcode',
- },
+ },
A hash ref where the keys are the regular expressions to
-use and the values are the constraints to apply.
+use and the values are the constraints to apply.
If one or more constraints have already been defined for a given field using
"constraints", constraint_regexp_map will add an additional constraint for that
@@ -1191,9 +1190,9 @@ field for each regular expression that matches.
B<Other modules in this distribution:>
-L<Data::FormValidator::Constraints|Data::FormValidator::Constraints>
+L<Data::FormValidator::Constraints|Data::FormValidator::Constraints>
-L<Data::FormValidator::Constraints::Dates|Data::FormValidator::Constraints::Dates>
+L<Data::FormValidator::Constraints::Dates|Data::FormValidator::Constraints::Dates>
L<Data::FormValidator::Constraints::Upload|Data::FormValidator::Constraints::Upload>
@@ -1203,13 +1202,13 @@ L<Data::FormValidator::Filters|Data::FormValidator::Filters>
L<Data::FormValidator::Results|Data::FormValidator::Results>
-B<A sample application by the maintainer:>
+B<A sample application by the maintainer:>
Validating Web Forms with Perl, L<http://mark.stosberg.com/Tech/perl/form-validation/>
B<Related modules:>
-L<Data::FormValidator::Tutorial|Data::FormValidator::Tutorial>
+L<Data::FormValidator::Tutorial|Data::FormValidator::Tutorial>
L<Data::FormValidator::Util::HTML|Data::FormValidator::Util::HTML>
@@ -1217,9 +1216,9 @@ L<CGI::Application::ValidateRM|CGI::Application::ValidateRM>, a
CGI::Application & Data::FormValidator glue module
L<HTML::Template::Associate::FormValidator|HTML::Template::Associate::FormValidator> is designed
-to make some kinds of integration with HTML::Template easier.
+to make some kinds of integration with HTML::Template easier.
-L<Params::Validate|Params::Validate> is useful for validating function parameters.
+L<Params::Validate|Params::Validate> is useful for validating function parameters.
L<Regexp::Common|Regexp::Common>,
L<Data::Types|Data::Types>,
@@ -1234,7 +1233,7 @@ B<Document Translations:>
Japanese: L<http://perldoc.jp/docs/modules/>
-B<Distributions which include Data::FormValidator>
+B<Distributions which include Data::FormValidator>
FreeBSD includes a port named B<p5-Data-FormValidator>
@@ -1251,9 +1250,9 @@ Albrecht to the MiniVend program.
=head1 BUGS
Bug reports and patches are welcome. Reports which include a failing Test::More
-style test are helpful will receive priority.
+style test are helpful will receive priority.
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-FormValidator>
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Data-FormValidator>
=head1 CONTRIBUTING
@@ -1262,13 +1261,13 @@ http://www.darcs.net/ ). My darcs archive is here:
http://mark.stosberg.com/darcs_hive/dfv/
B<Support Mailing List>
-
+
If you have any questions, comments, or feature suggestions, post them to the
support mailing list! To join the mailing list, visit
L<http://lists.sourceforge.net/lists/listinfo/cascade-dataform>
-Messages about DFV sent directly to the maintainer may be redirected here.
+Messages about DFV sent directly to the maintainer may be redirected here.
=head1 AUTHOR
@@ -1281,7 +1280,7 @@ Parts Copyright 1996-1999 by Michael J. Heins <mike@heins.net>
Parts Copyright 1996-1999 by Bruce Albrecht <bruce.albrecht@seag.fingerhut.com>
-=head1 LICENSE
+=head1 LICENSE
This program is free software; you can redistribute it and/or modify
it under the terms as perl itself.
@@ -11,7 +11,7 @@ use Test::More tests => 2;
my $q;
eval {
use CGI;
- $q = new CGI ({ my_zipcode_field => 'big brown' });
+ $q = CGI->new({ my_zipcode_field => 'big brown' });
};
ok(not $@);
@@ -41,7 +41,7 @@ ok(defined $result);
# Test multi-line input: someone might be using this for a textarea or somesuch
my $multiline_result = Data::FormValidator->check(
- {
+ my $expect = {
alpha => "apple\naeroplane\n", # 16 char
beta => "bus\nbuffalo\n", # 12 char
charlie => "cat\ncoconut\ncoffee\n", # 19 char
@@ -52,6 +52,7 @@ my $multiline_result = Data::FormValidator->check(
},
{
required => [qw/alpha beta charlie delta echo foxtrot golf/],
+ untaint_all_constraints => 1,
constraint_methods => {
alpha => FV_max_length(16), # max length
beta => FV_max_length(11), # too long
@@ -72,6 +73,11 @@ ok( $multiline_result->valid('echo'), 'multiline FV_length_between in bound
ok( $multiline_result->invalid('foxtrot'), 'multiline FV_length_between too short');
ok( $multiline_result->invalid('golf'), 'multiline FV_length_between too long' );
+# check expected values for valid untainted fields
+for my $field (qw( alpha charlie echo )) {
+ is( $multiline_result->valid($field), $expect->{$field}, "identity $field");
+}
+
# Test "long" results. Early implementations checked length with
# regular expressions which limit length options to 32kb.
# The 80000 char test string is an arbitrary length.
@@ -0,0 +1,73 @@
+#!perl
+# For RT#45177
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use Data::FormValidator;
+
+{
+ my $results = Data::FormValidator->check({ nine_is_ok => 9 }, {
+ required => [ 'nine_is_ok' ],
+ constraint_methods => { 'nine_is_ok' => qr/^(9)$/ },
+ untaint_all_constraints => 1,
+ });
+ is($results->valid('nine_is_ok'),9, "nine should be valid for 9 with capturing parens (untainted)");
+}
+{
+ my $results = Data::FormValidator->check({ nine_is_ok => 9 }, {
+ required => [ 'nine_is_ok' ],
+ constraint_methods => { 'nine_is_ok' => qr/^9$/ },
+ untaint_all_constraints => 1,
+ });
+ is($results->valid('nine_is_ok'),9, "nine should be valid for 9 without capturing parens (untainted)");
+}
+{
+ my $results = Data::FormValidator->check({ zero_is_ok => 0 }, {
+ required => [ 'zero_is_ok' ],
+ constraint_methods => { 'zero_is_ok' => qr/^0$/ },
+ untaint_all_constraints => 1,
+ });
+ is($results->valid('zero_is_ok'),0, "zero should be valid without capturing parens (untainted)");
+}
+{
+ my $results = Data::FormValidator->check({ zero_is_ok => 0 }, {
+ required => [ 'zero_is_ok' ],
+ constraint_methods => { 'zero_is_ok' => qr/^(0)$/ },
+ untaint_all_constraints => 1,
+ });
+ is($results->valid('zero_is_ok'),0, "zero should be valid with capturing parens (untainted)");
+}
+{
+ my $results = Data::FormValidator->check({ nine_is_ok => 9 }, {
+ required => [ 'nine_is_ok' ],
+ constraint_methods => { 'nine_is_ok' => qr/^(9)$/ },
+ });
+ is($results->valid('nine_is_ok'),9, "nine should be valid for 9 with capturing parens");
+}
+{
+ my $results = Data::FormValidator->check({ nine_is_ok => 9 }, {
+ required => [ 'nine_is_ok' ],
+ constraint_methods => { 'nine_is_ok' => qr/^9$/ },
+ });
+ is($results->valid('nine_is_ok'),9, "nine should be valid for 9 without capturing parens");
+}
+{
+ my $results = Data::FormValidator->check({ zero_is_ok => 0 }, {
+ required => [ 'zero_is_ok' ],
+ constraint_methods => { 'zero_is_ok' => qr/^0$/ },
+ });
+ is($results->valid('zero_is_ok'),0, "zero should be valid without capturing parens");
+}
+{
+ my $results = Data::FormValidator->check({ zero_is_ok => 0 }, {
+ required => [ 'zero_is_ok' ],
+ constraint_methods => { 'zero_is_ok' => qr/^(0)$/ },
+ });
+ is($results->valid('zero_is_ok'),0, "zero should be valid with capturing parens");
+}
+
+
+
+
@@ -7,7 +7,7 @@ use Data::FormValidator;
use Data::FormValidator::Constraints qw(:closures);
my $input_profile = {
- required => [ qw( number_field nan ) ],
+ required => [ qw( number_field nan nan_typo ) ],
optional => [ qw( nan_name_this ) ],
constraint_methods => {
number_field => sub {
@@ -1,4 +1,4 @@
-use Test::More qw/no_plan/;
+use Test::More 'no_plan';
use Data::FormValidator::Filters (qw/:filters/);
use strict;
@@ -9,6 +9,13 @@ use strict;
is_deeply( $comma_splitter->(),undef, "FV_split with no values");
}
+{
+ my $replacer = FV_replace(qr/^a/,'b');
+ is( $replacer->('aa'), 'ba', 'FV_replace positive test');
+ is( $replacer->('XX'), 'XX', 'FV_replace negative test');
+}
+
+
is( filter_dollars('There is $0.11e money in here somewhere'),
'0.11',
@@ -48,7 +48,7 @@ eval {
SKIP: {
skip 'CGI.pm not found', 3 if $@;
- my $q = new CGI($input_hashref);
+ my $q = CGI->new($input_hashref);
my ($valids, $missings, $invalids, $unknowns);
eval{
($valids, $missings, $invalids, $unknowns) = $validator->validate($q, 'default');
@@ -63,7 +63,7 @@ open(IN,'<t/upload_post_text.txt') || die 'missing test file';
binmode(IN);
*STDIN = *IN;
-$cgi_pm_q = new CGI;
+$cgi_pm_q = CGI->new;
close(IN);
## setup CGI::Simple testing
@@ -42,7 +42,7 @@ open(IN,'<t/upload_post_text.txt') || die 'missing test file';
binmode(IN);
*STDIN = *IN;
-my $q = new CGI;
+my $q = CGI->new;
use Data::FormValidator;
use Data::FormValidator::Constraints::Upload qw(